annotate src/sequence.c @ 5700:37479d841681

Fix subsetp based on patch by Benson and Steven Mitchell. Add appropriate short-circuits for null set arguments. Add tests (mostly from Steven Mitchell) to test suite.
author Stephen J. Turnbull <stephen@xemacs.org>
date Mon, 24 Dec 2012 14:12:51 +0900
parents 1a507c4c6c42
children 70a3f4ff8da8
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1 /* Various functions that operate on sequences, split out from fns.c
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2 Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2010 Ben Wing.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5 This file is part of XEmacs.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7 XEmacs is free software: you can redistribute it and/or modify it
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
9 Free Software Foundation, either version 3 of the License, or (at your
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
10 option) any later version.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
11
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
15 for more details.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
16
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
19
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
20 #include <config.h>
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
21 #include "lisp.h"
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
22 #include "extents.h"
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
23
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
24 Lisp_Object Qadjoin, Qarray, QassocX, Qbit_vector, Qcar_less_than_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
25 Lisp_Object QdeleteX, Qdelete_duplicates, Qevery, Qfill, Qfind, Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
26 Lisp_Object Qintersection, Qmap, Qmap_into, Qmapc, Qmapcan, QmapcarX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
27 Lisp_Object Qmapconcat, Qmapvector, Qmerge, Qmismatch, Qnintersection;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
28 Lisp_Object Qnset_difference, Qnsubstitute, Qnunion, Qposition, QrassocX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
29 Lisp_Object Qreduce, QremoveX, Qreplace, Qset_difference, Qsome, QsortX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
30 Lisp_Object Qstring_lessp, Qsubsetp, Qsubstitute, Qvector;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
31
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
32 Lisp_Object Q_count, Q_descend_structures, Q_end1, Q_end2, Q_from_end;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
33 Lisp_Object Q_if_, Q_if_not, Q_initial_value, Q_stable, Q_start1, Q_start2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
34 Lisp_Object Q_test_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
35
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
36 extern Fixnum max_lisp_eval_depth;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
37 extern int lisp_eval_depth;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
38
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
39 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
40
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
41 static DOESNT_RETURN
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
42 mapping_interaction_error (Lisp_Object func, Lisp_Object object)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
43 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
44 invalid_state_2 ("object modified while traversing it", func, object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
45 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
46
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
47 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
48 check_sequence_range (Lisp_Object sequence, Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
49 Lisp_Object end, Lisp_Object length)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
50 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
51 Lisp_Object args[] = { Qzero, start, NILP (end) ? length : end, length };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
52
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
53 if (NILP (Fleq (countof (args), args)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
54 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
55 args_out_of_range_3 (sequence, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
56 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
57 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
58
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
59 DEFUN ("length", Flength, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
60 Return the length of vector, bit vector, list or string SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
61 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
62 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
63 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
64 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
65 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
66 return make_fixnum (string_char_length (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
67 else if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
68 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
69 Elemcount len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
70 GET_EXTERNAL_LIST_LENGTH (sequence, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
71 return make_fixnum (len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
72 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
73 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
74 return make_fixnum (XVECTOR_LENGTH (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
75 else if (NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
76 return Qzero;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
77 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
78 return make_fixnum (bit_vector_length (XBIT_VECTOR (sequence)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
79 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
80 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
81 check_losing_bytecode ("length", sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
82 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
83 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
84 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
85 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
86
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
87 /* Various test functions for #'member*, #'assoc* and the other functions
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
88 that take both TEST and KEY arguments. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
89
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
90 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
91 check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
92 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
93 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
94 return EQ (item, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
95 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
96
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
97 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
98 check_eq_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
99 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
101 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
102 return EQ (item, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
105 /* The next two are not used by #'member* and #'assoc*, since we can decide
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
106 on #'eq vs. #'equal when we have the type of ITEM. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
107 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
108 check_eql_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
109 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
111 return EQ (elt1, elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
112 || (NON_FIXNUM_NUMBER_P (elt1) && internal_equal (elt1, elt2, 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
113 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
114
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
115 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
116 check_eql_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
117 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
119 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
120 return EQ (item, elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
121 || (NON_FIXNUM_NUMBER_P (item) && internal_equal (item, elt, 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
122 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
123
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
124 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
125 check_equal_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
126 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
127 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
128 return internal_equal (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
129 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
130
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
131 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
132 check_equal_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
133 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
135 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
136 return internal_equal (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
137 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
138
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
139 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
140 check_equalp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
141 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
142 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
143 return internal_equalp (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
144 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
145
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
146 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
147 check_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
148 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
149 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
150 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
151 return internal_equalp (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
153
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
154 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
155 check_string_match_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
156 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
158 return !NILP (Fstring_match (item, elt, Qnil, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
159 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
160
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
161 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
162 check_string_match_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
163 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
164 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
165 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
166 return !NILP (Fstring_match (item, elt, Qnil, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
168
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
169 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
170 check_other_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
171 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
172 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
173 Lisp_Object args[] = { test, item, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
174 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
175
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
176 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
177 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
178 item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
179 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
181 return !NILP (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
182 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
183
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
184 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
185 check_other_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
186 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
187 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
188 Lisp_Object args[] = { item, key, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
189 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
190
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
191 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
192 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
193 args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args) - 1, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
194 args[1] = item;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
195 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
196 item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
197 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
199 return !NILP (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
202 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
203 check_if_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
204 Lisp_Object UNUSED (item), Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
205 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
206 elt = IGNORE_MULTIPLE_VALUES (call1 (test, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
207 return !NILP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
208 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
209
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
210 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
211 check_if_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
212 Lisp_Object UNUSED (item), Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
213 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
214 Lisp_Object args[] = { key, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
215 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
216
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
217 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
218 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
219 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
220 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
221 elt = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
222 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
223
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
224 return !NILP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
225 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
227 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
228 check_match_eq_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
229 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
230 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
231 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
232 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
234 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
235 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
236 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
237 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
238 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
239 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
240
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
241 return EQ (args[0], args[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
242 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
243
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
244 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
245 check_match_eql_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
246 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
248 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
249 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
250
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
251 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
252 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
253 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
254 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
255 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
256 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
257
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
258 return EQ (args[0], args[1]) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
259 (NON_FIXNUM_NUMBER_P (args[0]) && internal_equal (args[0], args[1], 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
262 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
263 check_match_equal_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
264 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
266 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
267 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
269 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
270 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
271 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
272 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
273 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
274 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
276 return internal_equal (args[0], args[1], 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
277 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
278
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
279 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
280 check_match_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
281 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
283 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
284 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
285
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
286 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
287 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
288 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
289 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
290 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
291 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
293 return internal_equalp (args[0], args[1], 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
294 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
295
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
296 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
297 check_match_other_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
298 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
300 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
301 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
302
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
303 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
304 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
305 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
306 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
307 args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
308 args[1] = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
309 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
310
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
311 elt1 = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
312 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
314 return !NILP (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
316
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
317 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
318 check_lss_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
319 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
320 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
321 return bytecode_arithcompare (elt1, elt2) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
324 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
325 check_lss_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
326 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
327 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
328 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
329 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
331 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
332 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
333 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
334 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
335 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
336 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
337
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
338 return bytecode_arithcompare (args[0], args[1]) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
339 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
340
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
341 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
342 check_lss_key_car (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
343 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
344 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
345 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
346
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
347 GCPRO2 (elt1, elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
348 elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
349 elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
350 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
351
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
352 return bytecode_arithcompare (elt1, elt2) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
353 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
354
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
355 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
356 check_string_lessp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
357 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
359 return !NILP (Fstring_lessp (elt1, elt2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
360 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
362 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
363 check_string_lessp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
364 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
365 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
366 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
367 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
369 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
370 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
371 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
372 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
373 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
374 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
376 return !NILP (Fstring_lessp (args[0], args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
377 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
378
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
379 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
380 check_string_lessp_key_car (Lisp_Object UNUSED (test),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
381 Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
382 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
384 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
386 GCPRO2 (elt1, elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
387 elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
388 elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
389 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
391 return !NILP (Fstring_lessp (elt1, elt2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
394 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
395 get_check_match_function_1 (Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
396 Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
397 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
398 Lisp_Object key, Boolint *test_not_unboundp_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
399 check_test_func_t *test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
401 Lisp_Object test = *test_inout;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
402 check_test_func_t result = NULL, test_func = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
403 Boolint force_if = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
405 if (!NILP (if_))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
406 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
407 if (!(NILP (test) && NILP (test_not) && NILP (if_not)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
408 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
409 invalid_argument ("only one keyword among :test :test-not "
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
410 ":if :if-not allowed", if_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
411 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
412
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
413 test = *test_inout = if_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
414 force_if = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
416 else if (!NILP (if_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
417 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
418 if (!(NILP (test) && NILP (test_not)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
419 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
420 invalid_argument ("only one keyword among :test :test-not "
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
421 ":if :if-not allowed", if_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
422 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
423
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
424 test_not = if_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
425 force_if = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
426 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
427
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
428 if (NILP (test))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
429 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
430 if (!NILP (test_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
431 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
432 test = *test_inout = test_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
433 if (NULL != test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
435 *test_not_unboundp_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
436 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
437 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
438 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
439 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
440 test = Qeql;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
441 if (NULL != test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
443 *test_not_unboundp_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
444 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
445 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
446 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
447 else if (!NILP (test_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
448 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
449 invalid_argument_2 ("conflicting :test and :test-not keyword arguments",
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
450 test, test_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
452
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
453 test = indirect_function (test, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
455 if (NILP (key) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
456 EQ (indirect_function (key, 1), XSYMBOL_FUNCTION (Qidentity)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
458 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
461 if (force_if)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
462 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
463 result = EQ (key, Qidentity) ? check_if_nokey : check_if_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
465 if (NULL != test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
466 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
467 *test_func_out = result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
468 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
470 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
473 if (!UNBOUNDP (item) && EQ (test, XSYMBOL_FUNCTION (Qeql)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
474 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
475 test = XSYMBOL_FUNCTION (NON_FIXNUM_NUMBER_P (item) ? Qequal : Qeq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
476 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
477
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
478 #define FROB(known_test, eq_condition) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
479 if (EQ (test, XSYMBOL_FUNCTION (Q##known_test))) do \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
480 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
481 if (eq_condition) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
482 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
483 test = XSYMBOL_FUNCTION (Qeq); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
484 goto force_eq_check; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
485 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
486 \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
487 if (!EQ (Qidentity, key)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
488 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
489 test_func = check_##known_test##_key; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
490 result = check_match_##known_test##_key; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
491 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
492 else \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
493 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
494 result = test_func = check_##known_test##_nokey; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
495 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
496 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
498 FROB (eql, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
499 else if (SUBRP (test))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
500 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
501 force_eq_check:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
502 FROB (eq, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
503 else FROB (equal, (SYMBOLP (item) || FIXNUMP (item) || CHARP (item)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
504 else FROB (equalp, (SYMBOLP (item)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
505 else if (EQ (test, XSYMBOL_FUNCTION (Qstring_match)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
506 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
507 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
508 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
509 test_func = result = check_string_match_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
511 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
512 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
513 test_func = check_string_match_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
514 result = check_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
515 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
517 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
519 if (NULL == result)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
521 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
522 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
523 test_func = result = check_other_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
524 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
525 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
526 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
527 test_func = check_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
528 result = check_match_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
529 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
530 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
532 if (NULL != test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
533 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
534 *test_func_out = test_func;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
535 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
537 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
538 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
539 #undef FROB
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
541 /* Given TEST, TEST_NOT, IF, IF_NOT, KEY, and ITEM, return a C function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
542 pointer appropriate for use in deciding whether a given element of a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
543 sequence satisfies TEST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
545 Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
546 if it was bound, and set *test_inout to the value it was bound to. If
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
547 TEST was not bound, leave *test_inout alone; the value is not used by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
548 check_eq_*key() or check_equal_*key(), which are the defaults, depending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
549 on the type of ITEM.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
550
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
551 The returned function takes arguments (TEST, KEY, ITEM, ELT), where ITEM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
552 is the item being searched for and ELT is the element of the sequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
553 being examined.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
554
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
555 Error if both TEST and TEST_NOT were specified, which Common Lisp says is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
556 undefined behaviour. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
558 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
559 get_check_test_function (Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
560 Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
561 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
562 Lisp_Object key, Boolint *test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
563 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
564 check_test_func_t result = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
565 get_check_match_function_1 (item, test_inout, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
566 key, test_not_unboundp_out, &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
567 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
568 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
569
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
570 /* Given TEST, TEST_NOT, IF, IF_NOT and KEY, return a C function pointer
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
571 appropriate for use in deciding whether two given elements of a sequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
572 satisfy TEST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
574 Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
575 if it was bound, and set *test_inout to the value it was bound to. If
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
576 TEST was not bound, leave *test_inout alone; the value is not used by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
577 check_eql_*key().
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
578
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
579 The returned function takes arguments (TEST, KEY, ELT1, ELT2), where ELT1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
580 and ELT2 are elements of the sequence being examined.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
582 The value that would be given by get_check_test_function() is returned in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
583 *TEST_FUNC_OUT, which allows calling functions to do their own key checks
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
584 if they're processing one element at a time.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
585
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
586 Error if both TEST and TEST_NOT were specified, which Common Lisp says is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
587 undefined behaviour. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
589 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
590 get_check_match_function (Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
591 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
592 Lisp_Object key, Boolint *test_not_unboundp_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
593 check_test_func_t *test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
595 return get_check_match_function_1 (Qunbound, test_inout, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
596 if_, if_not, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
597 test_not_unboundp_out, test_func_out);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
599
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
600 /* Given PREDICATE and KEY, return a C function pointer appropriate for use
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
601 in deciding whether one given element of a sequence is less than
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
602 another. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
604 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
605 get_merge_predicate (Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
606 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
607 predicate = indirect_function (predicate, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
608
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
609 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
610 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
611 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
612 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
613 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
614 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
615 key = indirect_function (key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
616 if (EQ (key, XSYMBOL_FUNCTION (Qidentity)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
617 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
618 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
619 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
620 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
621
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
622 if (EQ (key, Qidentity) && EQ (predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
623 XSYMBOL_FUNCTION (Qcar_less_than_car)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
624 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
625 key = XSYMBOL_FUNCTION (Qcar);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
626 predicate = XSYMBOL_FUNCTION (Qlss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
627 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
628
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
629 if (EQ (predicate, XSYMBOL_FUNCTION (Qlss)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
631 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
633 return check_lss_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
634 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
635
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
636 if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
637 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
638 return check_lss_key_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
640
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
641 return check_lss_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
643
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
644 if (EQ (predicate, XSYMBOL_FUNCTION (Qstring_lessp)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
645 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
646 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
647 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
648 return check_string_lessp_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
649 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
651 if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
653 return check_string_lessp_key_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
655
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
656 return check_string_lessp_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
657 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
658
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
659 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
661 return check_other_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
664 return check_match_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
666
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
667
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
668 static Lisp_Object string_count_from_end (Lisp_Object, Lisp_Object ,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
669 check_test_func_t, Boolint,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
670 Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
671 Lisp_Object, Lisp_Object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
672
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
673 static Lisp_Object list_count_from_end (Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
674 check_test_func_t, Boolint,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
675 Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
676 Lisp_Object, Lisp_Object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
677
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
678 /* Count the number of occurrences of ITEM in SEQUENCE; if SEQUENCE is a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
679 list, store the cons cell of which the car is the last ITEM in SEQUENCE,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
680 at the address given by tail_out. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
682 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
683 count_with_tail (Lisp_Object *tail_out, int nargs, Lisp_Object *args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
684 Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
686 Lisp_Object item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
687 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
688 Elemcount len, ii = 0, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
689 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
690 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
692 PARSE_KEYWORDS_8 (caller, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
693 (test, key, start, end, from_end, test_not, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
694 if_, if_not), (start = Qzero), 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
696 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
697 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
698 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
700 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
701 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
702 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
703 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
706 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
707 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
708 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
709 counting = BIGNUMP (count) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
711 /* Our callers should have filtered out non-positive COUNT. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
712 assert (counting >= 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
713 /* And we're not prepared to handle COUNT from any other caller at the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
714 moment. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
715 assert (EQ (caller, QremoveX)|| EQ (caller, QdeleteX));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
716 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
718 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
719 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
721 *tail_out = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
722
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
723 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
724 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
725 if (EQ (caller, Qcount) && !NILP (from_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
726 && (!EQ (key, Qnil) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
727 check_test == check_other_nokey || check_test == check_if_nokey))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
728 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
729 /* #'count, #'count-if, and #'count-if-not are documented to have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
730 a given traversal order if :from-end t is passed in, even
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
731 though forward traversal of the sequence has the same result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
732 and is algorithmically less expensive for lists and strings.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
733 This order isn't necessary for other callers, though. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
734 return list_count_from_end (item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
735 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
736 start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
738
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
739 /* If COUNT is non-nil and FROM-END is t, we can give the tail
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
740 containing the last match, since that's what #'remove* is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
741 interested in (a zero or negative COUNT won't ever reach
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
742 count_with_tail(), our callers will return immediately on seeing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
743 it). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
744 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
745 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
746 counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
747 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
749 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
750 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
751 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
752 if (!(ii < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
753 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
754 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
755 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
756
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
757 if (starting <= ii &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
758 check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
759 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
760 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
761 *tail_out = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
763 if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
764 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
765 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
766 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
767 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
768
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
769 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
770 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
771 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
772 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
774 if ((ii < starting || (ii < ending && !NILP (end))) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
775 encountered != counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
776 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
777 check_sequence_range (args[1], start, end, Flength (args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
778 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
779 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
780 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
781 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
782 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
783 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
784 Lisp_Object character = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
785
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
786 if (EQ (caller, Qcount) && !NILP (from_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
787 && (!EQ (key, Qnil) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
788 check_test == check_other_nokey || check_test == check_if_nokey))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
789 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
790 /* See comment above in the list code. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
791 return string_count_from_end (item, sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
792 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
793 test, key, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
794 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
796 while (cursor_offset < byte_len && ii < ending && encountered < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
797 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
798 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
799 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
800 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
801
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
802 if (check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
803 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
804 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
805 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
806 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
807
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
808 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
809 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
810 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
811 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
812 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
813 mapping_interaction_error (caller, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
814 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
815 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
817 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
818 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
819 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
820 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
821
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
822 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
823 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
824 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
825 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
827 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
829 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
831 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
832 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
834 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
835 if (0 == len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
836 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
837 /* Catches the case where we have nil. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
838 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
839 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
840
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
841 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
842 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
843 for (ii = starting; ii < ending && encountered < counting; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
845 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
846 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
847 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
848 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
849 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
850 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
851 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
852 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
853 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
854 for (ii = ending - 1; ii >= starting && encountered < counting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
855 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
856 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
857 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
858 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
859 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
860 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
861 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
862 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
863 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
864
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
865 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
866 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
867
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
868 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
869 list_count_from_end (Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
870 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
871 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
872 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
873 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
874 Elemcount length = XFIXNUM (Flength (sequence)), ii = 0, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
875 Elemcount ending = NILP (end) ? length : XFIXNUM (end), encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
876 Lisp_Object *storage;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
877 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
878
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
879 check_sequence_range (sequence, start, end, make_integer (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
880
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
881 storage = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
882
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
883 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
884 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
885 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
886 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
887 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
888 storage[ii - starting] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
889 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
890 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
891 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
892 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
893
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
894 GCPRO1 (storage[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
895 gcpro1.nvars = ending - starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
897 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
898 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
899 if (check_test (test, key, item, storage[ii - starting])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
900 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
901 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
902 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
903 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
904 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
905
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
906 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
908 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
909 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
910
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
911 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
912 string_count_from_end (Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
913 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
914 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
915 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
917 Elemcount length = string_char_length (sequence), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
918 Elemcount starting = XFIXNUM (start), ending = NILP (end) ? length : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
919 Elemcount encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
920 Ibyte *cursor = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
921 Ibyte *endp = cursor + XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
922 Ichar *storage;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
923
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
924 check_sequence_range (sequence, start, end, make_integer (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
925
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
926 storage = alloca_array (Ichar, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
927
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
928 while (cursor < endp && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
929 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
930 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
931 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
932 storage [ii - starting] = itext_ichar (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
933 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
935 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
936 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
937 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
938
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
939 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
941 if (check_test (test, key, item, make_char (storage [ii - starting]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
942 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
944 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
945 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
946 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
947
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
948 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
949 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
951 DEFUN ("count", Fcount, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
952 Count the number of occurrences of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
954 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
955
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
956 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
957 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
958 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
959 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
960 Lisp_Object tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
961
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
962 /* count_with_tail() accepts more keywords than we do, check those we've
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
963 been given. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
964 PARSE_KEYWORDS (Fcount, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
965 (test, test_not, if_, if_not, key, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
966 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
968 return count_with_tail (&tail, nargs, args, Qcount);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
969 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
970
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
971 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
972 Return the subsequence of SEQUENCE starting at START and ending before END.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
973 END may be omitted; then the subsequence runs to the end of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
974
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
975 If START or END is negative, it counts from the end, in contravention of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
976 Common Lisp.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
977 The returned subsequence is always of the same type as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
978 If SEQUENCE is a string, relevant parts of the string-extent-data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
979 are copied to the new string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
980
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
981 See also `substring-no-properties', which only operates on strings, and does
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
982 not copy extent data.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
983 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
984 (sequence, start, end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
985 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
986 Elemcount len, ss, ee = MOST_POSITIVE_FIXNUM, ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
987 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
988
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
989 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
990 CHECK_FIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
991 ss = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
992
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
993 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
994 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
995 CHECK_FIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
996 ee = XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
997 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
998
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
999 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1000 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1001 Bytecount bstart, blen;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1002
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1003 get_string_range_char (sequence, start, end, &ss, &ee,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1004 GB_HISTORICAL_STRING_BEHAVIOR);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1005 bstart = string_index_char_to_byte (sequence, ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1006 blen = string_offset_char_to_byte_len (sequence, bstart, ee - ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1007
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1008 result = make_string (XSTRING_DATA (sequence) + bstart, blen);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1009 /* Copy any applicable extent information into the new string. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1010 copy_string_extents (result, sequence, 0, bstart, blen);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1012 else if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1013 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1014 Lisp_Object result_tail, saved = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1016 if (ss < 0 || ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1017 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1018 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1019 if (ss < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1020 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1021 ss = len + ss;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1022 start = make_integer (ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1023 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1025 if (ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1026 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1027 ee = len + ee;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1028 end = make_integer (ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1029 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1030 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1031 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1032 ee = min (ee, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1033 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1034 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1036 if (0 != ss)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1037 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1038 sequence = Fnthcdr (make_fixnum (ss), sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1039 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1041 ii = ss + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1043 if (ss < ee && !NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1045 result = result_tail = Fcons (Fcar (sequence), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1046 sequence = Fcdr (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1047
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1048 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1049 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1050 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1051 if (!(ii < ee))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1052 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1053 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1054 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1055
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1056 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1057 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1058 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1059 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1060 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1061 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1062
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1063 if (NILP (result) || (ii < ee && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1064 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1065 /* We were handed a cons, which definitely has elements. nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1066 result means either ss >= ee or SEQUENCE was nil after the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1067 nthcdr; in both cases that means START and END were incorrectly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1068 specified for this sequence. ii < ee with a non-nil end means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1069 the user handed us a bogus end value. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1070 check_sequence_range (saved, start, end, Flength (saved));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1071 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1072 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1073 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1074 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1075 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1076 if (ss < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1077 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1078 ss = len + ss;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1079 start = make_integer (ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1080 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1081
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1082 if (ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1083 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1084 ee = len + ee;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1085 end = make_integer (ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1086 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1087 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1088 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1089 ee = min (len, ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1090 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1091
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1092 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1093
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1094 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1095 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1096 result = Fvector (ee - ss, XVECTOR_DATA (sequence) + ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1097 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1098 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1099 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1100 result = make_bit_vector (ee - ss, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1101
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1102 for (ii = ss; ii < ee; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1103 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1104 set_bit_vector_bit (XBIT_VECTOR (result), ii - ss,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1105 bit_vector_bit (XBIT_VECTOR (sequence), ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1106 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1107 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1108 else if (NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1109 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1110 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1111 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1112 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1113 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1114 /* Won't happen, since CHECK_SEQUENCE didn't error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1115 ABORT ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1116 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1117 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1118
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1119 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1120 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1121
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1122 DEFUN ("elt", Felt, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1123 Return element of SEQUENCE at index N.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1124 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1125 (sequence, n))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1127 /* This function can GC */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1128 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1129 CHECK_FIXNUM_COERCE_CHAR (n); /* yuck! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1130 if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1131 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1132 Lisp_Object tem = Fnthcdr (n, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1133 /* #### Utterly, completely, fucking disgusting.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1134 * #### The whole point of "elt" is that it operates on
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1135 * #### sequences, and does error- (bounds-) checking.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1136 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1137 if (CONSP (tem))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1138 return XCAR (tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1139 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1140 #if 1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1141 /* This is The Way It Has Always Been. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1142 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1143 #else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1144 /* This is The Way Mly and Cltl2 say It Should Be. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1145 args_out_of_range (sequence, n);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1146 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1148 else if (STRINGP (sequence) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1149 VECTORP (sequence) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1150 BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1151 return Faref (sequence, n);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1152 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1153 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1154 check_losing_bytecode ("elt", sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1155 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1156 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1157 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1158 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1159
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1160 DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1161 Return a copy of a list and substructures.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1162 The argument is copied, and any lists contained within it are copied
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1163 recursively. Circularities and shared substructures are not preserved.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1164 Second arg VECP causes vectors to be copied, too. Strings and bit vectors
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1165 are not copied.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1166 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1167 (arg, vecp))
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 return safe_copy_tree (arg, vecp, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1170 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1171
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1172 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1173 safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1174 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1175 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1176 stack_overflow ("Stack overflow in copy-tree", arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1177
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1178 if (CONSP (arg))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1179 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1180 Lisp_Object rest;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1181 rest = arg = Fcopy_sequence (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1182 while (CONSP (rest))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1183 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1184 Lisp_Object elt = XCAR (rest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1185 QUIT;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1186 if (CONSP (elt) || VECTORP (elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1187 XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1188 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1189 XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1190 rest = XCDR (rest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1191 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1192 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1193 else if (VECTORP (arg) && ! NILP (vecp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1194 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1195 int i = XVECTOR_LENGTH (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1196 int j;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1197 arg = Fcopy_sequence (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1198 for (j = 0; j < i; j++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1199 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1200 Lisp_Object elt = XVECTOR_DATA (arg) [j];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1201 QUIT;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1202 if (CONSP (elt) || VECTORP (elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1203 XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1204 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1205 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1206 return arg;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1207 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1208
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1209 DEFUN ("member", Fmember, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1210 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1211 The value is actually the tail of LIST whose car is ELT.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1212 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1213 (elt, list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1214 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1215 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1216 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1217 if (internal_equal (elt, list_elt, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1218 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1219 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1220 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1221 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1222
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1223 DEFUN ("memq", Fmemq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1224 Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1225 The value is actually the tail of LIST whose car is ELT.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1226 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1227 (elt, list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1228 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1229 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1230 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1231 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1232 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1233 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1234 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1235 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1236
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1237 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1238 memq_no_quit (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1239 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1240 LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1241 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1242 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1243 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1244 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1245 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1246 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1247
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1248 /* Return the first index of ITEM in LIST. In CONS_OUT, return the cons cell
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1249 before that containing the element. If the element is in the first cons
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1250 cell, return Qnil in CONS_OUT. TEST, KEY, START, END are as in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1251 #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should have been initialized
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1252 with get_check_match_function() or get_check_test_function(). A non-zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1253 REVERSE_TEST_ORDER means call TEST with the element from LIST as its
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1254 first argument and ITEM as its second. Error if LIST is ill-formed, or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1255 circular. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1256 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1257 list_position_cons_before (Lisp_Object *cons_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1258 Lisp_Object item, Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1259 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1260 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1261 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1262 Boolint reverse_test_order,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1263 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1264 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1265 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1266 Lisp_Object tail_before = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1267 Elemcount ii = 0, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1268 Elemcount ending = NILP (end) ? MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1269
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1270 GCPRO1 (tail_before);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1271
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1272 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1273 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1274 /* TEST is #'eq, no need to call any C functions, and the test order
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1275 won't be visible. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1276 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1278 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1279 EQ (item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1280 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1281 *cons_out = tail_before;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1282 RETURN_UNGCPRO (make_integer (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1283 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1284 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1286 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1287 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1288 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1289 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1290 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1291 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1292 tail_before = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1293 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1294 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1295 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1296 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1297 GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1298 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1299 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1300 (reverse_test_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1301 check_test (test, key, elt, item) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1302 check_test (test, key, item, elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1303 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1304 *cons_out = tail_before;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1305 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1306 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1307 return make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1308 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1309 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1310 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1311 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1312 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1313 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1314 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1316 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1317 tail_before = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1318 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1319 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1320 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1321
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1322 RETURN_UNGCPRO (Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1323 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1324
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1325 DEFUN ("member*", FmemberX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1326 Return the first sublist of LIST with car ITEM, or nil if no such sublist.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1327
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1328 The keyword :test specifies a two-argument function that is used to compare
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1329 ITEM with elements in LIST; if omitted, it defaults to `eql'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1331 The keyword :test-not is similar, but specifies a negated function. That
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1332 is, ITEM is considered equal to an element in LIST if the given function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1333 returns nil. Common Lisp deprecates :test-not, and if both are specified,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1334 XEmacs signals an error.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1335
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1336 :key specifies a one-argument function that transforms elements of LIST into
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1337 \"comparison keys\" before the test predicate is applied. For example,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1338 if :key is #'car, then ITEM is compared with the car of elements from LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1339 The :key function, however, is not applied to ITEM, and does not affect the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1340 elements in the returned list, which are taken directly from the elements in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1341 LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1342
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1343 arguments: (ITEM LIST &key (TEST #'eql) TEST-NOT (KEY #'identity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1344 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1345 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1346 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1347 Lisp_Object item = args[0], list = args[1], result = Qnil, position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1348 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1349 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1350
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1351 PARSE_KEYWORDS (FmemberX, nargs, args, 5, (test, if_not, if_, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1352 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1353 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1354 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1355 position0
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1356 = list_position_cons_before (&result, item, list, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1357 test_not_unboundp, test, key, 0, Qzero, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1358
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1359 return CONSP (result) ? XCDR (result) : ZEROP (position0) ? list : Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1360 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1362 /* This macro might eventually find a better home than here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1363
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1364 #define CHECK_KEY_ARGUMENT(key) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1365 do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1366 if (NILP (key)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1367 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1368 key = Qidentity; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1369 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1370 \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1371 if (!EQ (key, Qidentity)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1372 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1373 key = indirect_function (key, 1); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1374 if (EQ (key, XSYMBOL_FUNCTION (Qidentity))) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1375 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1376 key = Qidentity; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1377 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1378 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1379 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1380
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1381 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1382 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1383
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1384 DEFUN ("adjoin", Fadjoin, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1385 Return ITEM consed onto the front of LIST, if not already in LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1387 Otherwise, return LIST unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1388
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1389 See `member*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1391 arguments: (ITEM LIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1392 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1393 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1395 Lisp_Object item = args[0], list = args[1], keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1396 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1397 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1398 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1399
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1400 PARSE_KEYWORDS (Fadjoin, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1401 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1402
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1403 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1405 keyed = KEY (key, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1406
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1407 GCPRO1 (keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1408 check_test = get_check_test_function (keyed, &test, test_not, Qnil, Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1409 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1410 if (NILP (list_position_cons_before (&ignore, keyed, list, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1411 test_not_unboundp, test, key, 0, Qzero,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1412 Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1413 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1414 RETURN_UNGCPRO (Fcons (item, list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1417 RETURN_UNGCPRO (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1418 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1419
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1420 DEFUN ("assoc", Fassoc, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1421 Return non-nil if KEY is `equal' to the car of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1422 The value is actually the element of ALIST whose car equals KEY.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1423 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1424 (key, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1425 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1426 /* This function can GC. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1427 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1428 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1429 if (internal_equal (key, elt_car, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1430 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1431 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1432 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1433 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1434
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1435 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1436 assoc_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1437 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1438 int speccount = specpdl_depth ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1439 specbind (Qinhibit_quit, Qt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1440 return unbind_to_1 (speccount, Fassoc (key, alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1441 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1442
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1443 DEFUN ("assq", Fassq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1444 Return non-nil if KEY is `eq' to the car of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1445 The value is actually the element of ALIST whose car is KEY.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1446 Elements of ALIST that are not conses are ignored.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1447 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1448 (key, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1450 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1451 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1452 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1453 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1454 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1455 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1456 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1458 /* Like Fassq but never report an error and do not allow quits.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1459 Use only on lists known never to be circular. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1461 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1462 assq_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1463 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1464 /* This cannot GC. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1465 LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1466 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1467 Lisp_Object elt_car = XCAR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1468 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1469 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1470 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1471 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1472 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1473
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1474 DEFUN ("assoc*", FassocX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1475 Find the first item whose car matches ITEM in ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1477 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1478
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1479 arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1480 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1481 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1482 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1483 Lisp_Object item = args[0], alist = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1484 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1485 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1486
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1487 PARSE_KEYWORDS (FassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1488 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1489
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1490 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1491 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1492
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1493 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1494 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1495 /* TEST is #'eq, no need to call any C functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1496 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1497 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1498 if (EQ (item, elt_car) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1499 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1500 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1501 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1502 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1503 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1504 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1505 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1506 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1507 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1508 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1509 check_test (test, key, item, XCAR (elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1510 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1511 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1512 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1513 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1514 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1515 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1518 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1519 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1520
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1521 DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1522 Return non-nil if VALUE is `equal' to the cdr of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1523 The value is actually the element of ALIST whose cdr equals VALUE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1524 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1525 (value, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1526 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1527 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1528 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1529 if (internal_equal (value, elt_cdr, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1530 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1531 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1532 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1533 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1534
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1535 DEFUN ("rassq", Frassq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1536 Return non-nil if VALUE is `eq' to the cdr of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1537 The value is actually the element of ALIST whose cdr is VALUE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1538 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1539 (value, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1540 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1541 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1542 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1543 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1544 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1545 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1546 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1547 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1548
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1549 /* Like Frassq, but caller must ensure that ALIST is properly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1550 nil-terminated and ebola-free. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1551 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1552 rassq_no_quit (Lisp_Object value, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1553 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1554 LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1555 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1556 Lisp_Object elt_cdr = XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1557 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1558 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1559 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1560 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1561 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1562
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1563 DEFUN ("rassoc*", FrassocX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1564 Find the first item whose cdr matches ITEM in ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1565
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1566 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1567
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1568 arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1569 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1570 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1571 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1572 Lisp_Object item = args[0], alist = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1573 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1574 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1575
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1576 PARSE_KEYWORDS (FrassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1577 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1578
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1579 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1580 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1582 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1583 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1584 /* TEST is #'eq, no need to call any C functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1585 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1586 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1587 if (EQ (item, elt_cdr) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1589 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1590 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1591 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1592 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1593 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1595 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1596 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1597 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1598 check_test (test, key, item, XCDR (elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1599 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1600 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1601 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1603 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1604 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1605 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1606
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1607 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1608 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1609
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1610 /* This is the implementation of both #'find and #'position. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1611 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1612 position (Lisp_Object *object_out, Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1613 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1614 Lisp_Object test, Lisp_Object key, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1615 Lisp_Object from_end, Lisp_Object default_, Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1616 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1617 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1618 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, len, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1619
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1620 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1621 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1622 starting = FIXNUMP (start) ? XFIXNUM (start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1623
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1624 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1626 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1627 ending = FIXNUMP (end) ? XFIXNUM (end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1628 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1629
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1630 *object_out = default_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1631
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1632 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1633 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1634 if (!(starting < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1635 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1636 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1637 /* starting could be equal to ending, in which case nil is what
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1638 we want to return. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1639 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1640 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1641
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1642 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1643 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1644 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1645 if (starting <= ii && ii < ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1646 && check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1647 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1648 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1649 *object_out = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1651 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1653 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1654 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1655 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1656 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1657 else if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1658 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1659 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1660 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1661
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1662 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1663 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1664 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1666
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1667 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1669 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1670 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1671 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1672 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1673 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1674 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1675 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1676 Lisp_Object character = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1677
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1678 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1679 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1680 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1681 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1682 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1683
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1684 if (check_test (test, key, item, character) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1686 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1687 *object_out = character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1688
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1689 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1690 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1691 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1692 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1693 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1695 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1696 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1697 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1698 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1699 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1700 mapping_interaction_error (caller, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1701 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1703
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1704 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1705 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1706 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1707 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1708
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1709 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1710 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1711 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1713 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1714 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1715 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1716 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1717 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1718 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1719
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1720 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1721 if (0 == len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1722 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1723 /* Catches the case where we have nil. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1724 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1725 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1726
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1727 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1728 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1729 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1730 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1731 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1732 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1733 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1734 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1735 *object_out = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1736 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1738 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1739 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1740 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1741 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1742 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1743 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1744 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1745 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1746 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1747 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1748 *object_out = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1749 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1750 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1751 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1752 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1753 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1754
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1755 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1756 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1757
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1758 DEFUN ("position", Fposition, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1759 Return the index of the first occurrence of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1760
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1761 Return nil if not found. See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1763 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1764 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1765 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1766 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1767 Lisp_Object object = Qnil, item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1768 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1769 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1770
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1771 PARSE_KEYWORDS (Fposition, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1772 (test, if_, test_not, if_not, key, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1773 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1775 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1776 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1777
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1778 return position (&object, item, sequence, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1779 test, key, start, end, from_end, Qnil, Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1780 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1781
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1782 DEFUN ("find", Ffind, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1783 Find the first occurrence of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1785 Return the matching ITEM, or nil if not found. See `remove*' for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1786 meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1787
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1788 The keyword :default, not specified by Common Lisp, designates an object to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1789 return instead of nil if ITEM is not found.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1790
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1791 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) DEFAULT FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1792 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1793 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1794 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1795 Lisp_Object object = Qnil, item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1796 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1797 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1798
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1799 PARSE_KEYWORDS (Ffind, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1800 (test, if_, test_not, if_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1801 default_),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1802 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1803
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1804 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1805 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1806
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1807 position (&object, item, sequence, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1808 test, key, start, end, from_end, default_, Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1810 return object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1811 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1812
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1813 /* Like #'delq, but caller must ensure that LIST is properly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1814 nil-terminated and ebola-free. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1815
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1816 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1817 delq_no_quit (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1818 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1819 LIST_LOOP_DELETE_IF (list_elt, list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1820 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1821 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1822 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1823
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1824 /* Be VERY careful with this. This is like delq_no_quit() but
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1825 also calls free_cons() on the removed conses. You must be SURE
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1826 that no pointers to the freed conses remain around (e.g.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1827 someone else is pointing to part of the list). This function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1828 is useful on internal lists that are used frequently and where
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1829 the actual list doesn't escape beyond known code bounds. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1831 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1832 delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1833 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1834 REGISTER Lisp_Object tail = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1835 REGISTER Lisp_Object prev = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1836
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1837 while (!NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1838 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1839 REGISTER Lisp_Object tem = XCAR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1840 if (EQ (elt, tem))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1841 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1842 Lisp_Object cons_to_free = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1843 if (NILP (prev))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1844 list = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1845 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1846 XCDR (prev) = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1847 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1848 free_cons (cons_to_free);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1849 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1850 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1851 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1852 prev = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1853 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1854 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1855 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1856 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1857 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1859 DEFUN ("delete*", FdeleteX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1860 Remove all occurrences of ITEM in SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1861
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1862 If SEQUENCE is a non-nil list, this modifies the list directly. A non-list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1863 SEQUENCE will not be destructively modified, rather, if ITEM occurs in it, a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1864 new SEQUENCE of the same type without ITEM will be returned.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1865
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1866 See `remove*' for a non-destructive alternative, and for explanation of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1867 keyword arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1868
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1869 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1870 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1871 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1872 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1873 Lisp_Object item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1874 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1875 Elemcount len, ii = 0, encountered = 0, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1876 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1877 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1878
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1879 PARSE_KEYWORDS (FdeleteX, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1880 (test, if_not, if_, test_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1881 count), (start = Qzero, count = Qunbound));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1882
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1883 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1884 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1885 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1886
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1887 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1888 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1889 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1890 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1891 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1892
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1893 if (!UNBOUNDP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1895 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1896 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1897 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1898 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1899 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1900 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1901 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1902 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1903 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1904 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1905 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1906 1 + MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1907 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1908 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1909
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1910 if (counting < 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1911 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1912 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1913 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1914
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1915 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1917 /* Sigh, this is inelegant. Force count_with_tail () to ignore
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1918 the count keyword, so we get the actual number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1919 elements, and can start removing from the beginning for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1920 from-end case. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1921 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FdeleteX))->min_args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1922 ii < nargs; ii += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1923 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1924 if (EQ (args[ii], Q_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1925 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1926 args[ii + 1] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1927 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1928 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1929 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1930 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1931 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1932 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1933 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1935 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1936 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1937
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1938 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1939 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1940 Lisp_Object prev_tail_list_elt = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1941 Elemcount list_len = 0, deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1942 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1944 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1945 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1946 /* Both COUNT and FROM-END were specified; we need to traverse the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1947 list twice. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1948 Lisp_Object present = count_with_tail (&ignore, nargs, args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1949 QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1951 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1952 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1953 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1954 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1955
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1956 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1957
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1958 /* If there are fewer items in the list than we have permission to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1959 delete, we don't need to differentiate between the :from-end
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1960 nil and :from-end t cases. Otherwise, presenting is the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1961 of matching items we need to ignore before we start to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1962 delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1963 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1965
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1966 GCPRO1 (prev_tail_list_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1967 ii = -1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1968
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1969 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1970 GC_EXTERNAL_LIST_LOOP_4 (list_elt, sequence, tail, list_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1971 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1972 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1973
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1974 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1975 (check_test (test, key, item, list_elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1976 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1977 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1978 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1979 if (NILP (prev_tail_list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1981 sequence = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1982 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1983 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1984 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1985 XSETCDR (prev_tail_list_elt, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1986 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1987
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1988 /* Keep tortoise from ever passing hare. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1989 list_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1990 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1992 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1993 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1994 prev_tail_list_elt = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1995 if (ii >= ending || (!presenting && encountered > counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1996 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1997 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1998 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2000 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2001 END_GC_EXTERNAL_LIST_LOOP (list_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2002 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2003
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2004 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2005
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2006 if ((ii < starting || (ii < ending && !NILP (end))) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2007 !(presenting ? encountered == presenting : encountered == counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2008 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2009 check_sequence_range (args[1], start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2010 make_fixnum (deleted + XFIXNUM (Flength (args[1]))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2013 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2014 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2015 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2016 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2017 Ibyte *staging = alloca_ibytes (XSTRING_LENGTH (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2018 Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2019 Ibyte *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2020 Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2021 Lisp_Object character, result = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2022
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2023 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2024 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2025 Lisp_Object present = count_with_tail (&character, nargs, args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2026 QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2027
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2028 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2029 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2030 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2031 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2032
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2033 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2034
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2035 /* If there are fewer items in the list than we have permission to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2036 delete, we don't need to differentiate between the :from-end
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2037 nil and :from-end t cases. Otherwise, presenting is the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2038 of matching items we need to ignore before we start to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2039 delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2040 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2041 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2043 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2044 while (cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2045 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2046 if (ii >= starting && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2047 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2048 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2049
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2050 if ((check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2051 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2052 && (presenting ? encountered++ >= presenting :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2053 encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2054 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2055 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2056 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2057 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2058 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2059 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2060 += set_itext_ichar (staging_cursor, XCHAR (character));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2061 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2062
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2063 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2064 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2065 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2066 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2067 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2068 mapping_interaction_error (QdeleteX, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2070 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2071 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2072 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2073 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2074 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2075
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2076 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2077 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2078 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2080
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2081 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2082 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2083 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2084 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2085
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2086 if (0 != encountered)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2087 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2088 result = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2089 copy_string_extents (result, sequence, 0, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2090 staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2091 sequence = result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2092 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2093
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2094 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2095 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2096 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2097 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2098 Lisp_Object position0 = Qnil, object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2099 Lisp_Object *staging = NULL, *staging_cursor, *staging_limit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2100 Elemcount positioning;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2101
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2102 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2103
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2104 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2105
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2106 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2107 test_not_unboundp, test, key, start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2108 from_end, Qnil, QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2109 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2111 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2112 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2113
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2114 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2115 positioning = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2116 encountered = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2117
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2118 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2119 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2120 staging = alloca_array (Lisp_Object, len - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2121 staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2122
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2123 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2124 while (ii < positioning)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2126 *staging_cursor++ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2127 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2129
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2130 ii = positioning + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2131 while (ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2132 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2133 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2134 if (encountered < counting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2135 && (check_test (test, key, item, object)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2136 == test_not_unboundp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2137 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2138 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2139 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2140 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2141 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2142 *staging_cursor++ = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2143 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2144 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2146
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2147 while (ii < len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2148 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2149 *staging_cursor++ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2150 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2151 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2153 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2154 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2155 staging = alloca_array (Lisp_Object, len - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2156 staging_cursor = staging_limit = staging + len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2157
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2158 ii = len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2159 while (ii > positioning)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2161 *--staging_cursor = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2162 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2163 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2164
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2165 ii = positioning - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2166 while (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2167 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2168 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2169 if (encountered < counting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2170 && (check_test (test, key, item, object) ==
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2171 test_not_unboundp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2172 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2173 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2174 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2175 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2176 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2177 *--staging_cursor = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2178 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2179
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2180 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2181 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2182
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2183 while (ii >= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2184 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2185 *--staging_cursor = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2186 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2187 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2188
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2189 staging = staging_cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2190 staging_cursor = staging_limit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2191 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2192
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2193 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2194 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2195 return Fvector (staging_cursor - staging, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2196 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2197 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2198 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2199 return Fbit_vector (staging_cursor - staging, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2202 /* A nil sequence will have given us a nil #'position,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2203 above. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2204 ABORT ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2206 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2207 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2208 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2209
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2210 DEFUN ("remove*", FremoveX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2211 Remove all occurrences of ITEM in SEQUENCE, non-destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2212
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2213 If SEQUENCE is a list, `remove*' makes a copy if that is necessary to avoid
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2214 corrupting the original SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2215
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2216 The keywords :test and :test-not specify two-argument test and negated-test
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2217 predicates, respectively; :test defaults to `eql'. :key specifies a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2218 one-argument function that transforms elements of SEQUENCE into \"comparison
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2219 keys\" before the test predicate is applied. See `member*' for more
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2220 information on these keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2221
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2222 :start and :end, if given, specify indices of a subsequence of SEQUENCE to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2223 be processed. Indices are 0-based and processing involves the subsequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2224 starting at the index given by :start and ending just before the index given
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2225 by :end.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2227 :count, if given, limits the number of items removed to the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2228 specified. :from-end, if given, causes processing to proceed starting from
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2229 the end instead of the beginning; in this case, this matters only if :count
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2230 is given.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2231
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2232 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2233 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2234 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2235 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2236 Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2237 tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2238 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2239 Elemcount ii = 0, encountered = 0, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2240 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2241 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2242
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2243 PARSE_KEYWORDS (FremoveX, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2244 (test, if_not, if_, test_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2245 count), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2246
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2247 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2248 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2249 return FdeleteX (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2250 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2251
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2252 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2253 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2254
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2255 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2256 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2257 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2258 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2259 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2260
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2261 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2262 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2263 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2264 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2266 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2267 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2268 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2269 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2270 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2271 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2272 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2273 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2274 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2276 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2278 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2279 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2280
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2281 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2283 /* Sigh, this is inelegant. Force count_with_tail () to ignore the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2284 count keyword, so we get the actual number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2285 elements, and can start removing from the beginning for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2286 from-end case. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2287 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FremoveX))->min_args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2288 ii < nargs; ii += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2289 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2290 if (EQ (args[ii], Q_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2291 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2292 args[ii + 1] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2293 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2294 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2295 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2296 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2297 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2298 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2299
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2300 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2301 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2302
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2303 matched_count = count_with_tail (&tail, nargs, args, QremoveX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2304
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2305 if (!ZEROP (matched_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2306 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2307 Lisp_Object result = Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2308 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2309
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2310 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2311 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2312 presenting = XFIXNUM (matched_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2314 /* If there are fewer matching elements in the list than we have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2315 permission to delete, we don't need to differentiate between
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2316 the :from-end nil and :from-end t cases. Otherwise, presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2317 is the number of matching items we need to ignore before we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2318 start to delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2319 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2320 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2321
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2322 GCPRO2 (result, tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2323 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2324 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2325 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2326 if (EQ (tail, tailing))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2327 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2328 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2329 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2331 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2332 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2333 return XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2334 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2335
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2336 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2337 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2338 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2339 else if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2340 (check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2341 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2342 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2344 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2345 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2346 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2347 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2348 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2349 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2350 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2351 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2352 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2353 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2354 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2355
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2356 if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2357 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2358 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2359 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2360
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2361 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2363 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2364 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2365 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2366
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2367 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2368 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2369 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2370 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2371
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2372 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2373 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2374
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2375 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2376 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2377
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2378 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2379 remassoc_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2380 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2381 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2382 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2383 internal_equal (key, XCAR (elt), 0)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2384 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2385 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2387 /* no quit, no errors; be careful */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2388
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2389 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2390 remassq_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2391 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2392 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2393 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2394 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2395 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2396 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2397
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2398 /* Like Fremrassq, fast and unsafe; be careful */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2399 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2400 remrassq_no_quit (Lisp_Object value, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2401 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2402 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2403 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2404 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2405 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2406 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2407
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2408 /* Remove duplicate elements between START and END from LIST, a non-nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2409 list; if COPY is zero, do so destructively. Items to delete are selected
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2410 according to the algorithm used when :from-end t is passed to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2411 #'delete-duplicates. Error if LIST is ill-formed or circular.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2412
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2413 TEST and KEY are as in #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2414 reflect them, having been initialised with get_check_match_function() or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2415 get_check_test_function(). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2416 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2417 list_delete_duplicates_from_end (Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2418 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2419 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2420 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2421 Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2422 Lisp_Object end, Boolint copy)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2423 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2424 Lisp_Object checking = Qnil, result = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2425 Lisp_Object keyed, positioned, position_cons = Qnil, result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2426 Elemcount len = XFIXNUM (Flength (list)), pos, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2427 Elemcount ending = (NILP (end) ? len : XFIXNUM (end)), greatest_pos_seen = -1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2428 Elemcount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2429 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2430
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2431 /* We can't delete (or remove) as we go, because that breaks START and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2432 END. We could if END were nil, and that would change an ON(N + 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2433 algorithm to an ON^2 algorithm. Here and now it doesn't matter, though,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2434 #'delete-duplicates is relatively expensive no matter what. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2435 struct Lisp_Bit_Vector *deleting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2436 = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2437 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2438 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2439 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2441 check_sequence_range (list, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2442
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2443 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2444 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2445 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2446
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2447 GCPRO1 (keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2448
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2450 GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2451 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2452 if (!(starting <= ii && ii <= ending) || bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2453 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2454 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2455 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2456 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2458 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2459 checking = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2460 pos = ii + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2461
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2462 while (!NILP ((positioned = list_position_cons_before
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2463 (&position_cons, keyed, checking, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2464 test_not_unboundp, test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2465 make_fixnum (max (starting - pos, 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2466 make_fixnum (ending - pos)))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2467 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2468 pos = XFIXNUM (positioned) + pos;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2469 set_bit_vector_bit (deleting, pos, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2470 greatest_pos_seen = max (greatest_pos_seen, pos);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2471 checking = NILP (position_cons) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2472 XCDR (checking) : XCDR (XCDR (position_cons));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2473 pos += 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2474 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2475 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2476 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2477 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2478 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2479
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2480 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2481
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2482 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2484 if (greatest_pos_seen > -1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2485 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2486 if (copy)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2487 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2488 result = result_tail = Fcons (XCAR (list), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2489 list = XCDR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2490 ii = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2492 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2493 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2494 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2495 if (ii == greatest_pos_seen)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2496 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2497 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2498 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2500 else if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2501 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2502 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2503 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2504 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2505 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2506 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2507 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2508 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2509 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2510 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2511 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2512 bit_vector_bit (deleting, ii++));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2513 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2514 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2515
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2516 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2517 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2519 DEFUN ("delete-duplicates", Fdelete_duplicates, 1, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2520 Remove all duplicate elements from SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2521
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2522 If SEQUENCE is a list and has duplicates, modify and return it. Note that
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2523 SEQUENCE may start with an element to be deleted; because of this, if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2524 modifying a variable, be sure to write `(setq VARIABLE (delete-duplicates
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2525 VARIABLE))' to be certain to have a list without duplicate elements.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2526
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2527 If SEQUENCE is an array and has duplicates, return a newly-allocated array
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2528 of the same type comprising all unique elements of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2529
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2530 If there are no duplicate elements in SEQUENCE, return it unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2532 See `remove*' for the meaning of the keywords. See `remove-duplicates' for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2533 a non-destructive version of this function.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2534
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2535 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2536 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2537 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2538 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2539 Lisp_Object sequence = args[0], keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2540 Lisp_Object positioned = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2541 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, len, ii = 0, jj = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2542 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2543 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2544 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2546 PARSE_KEYWORDS (Fdelete_duplicates, nargs, args, 6,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2547 (test, key, test_not, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2548 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2549
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2550 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2551 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2552 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2553
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2554 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2555 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2556 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2557 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2558 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2559
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2560 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2561
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2562 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2563 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2565 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2566 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2567 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2569 Lisp_Object prev_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2570 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2571
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2572 GCPRO2 (keyed, prev_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2574 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2575 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2576 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2577 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2578 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2579 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2580 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2581 = list_position_cons_before (&ignore, keyed,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2582 XCDR (tail), check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2583 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2584 0, make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2585 - (ii + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2586 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2587 make_fixnum (ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2588 - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2589 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2590 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2591 sequence = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2592 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2593 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2594 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2595 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2596 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2597 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2599 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2600 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2601 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2604 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2605 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2606 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2607 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2609 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2610 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2611 if (!(starting <= ii && ii <= ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2612 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2613 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2614 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2615 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2616 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2617
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2618 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2619 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2620 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2621 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2622 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2623 make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2624 - (ii + 1), 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2625 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2626 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2628 /* We know this isn't the first iteration of the loop,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2629 because we advanced above to the point where we have at
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2630 least one non-duplicate entry at the head of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2631 list. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2632 XSETCDR (prev_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2633 len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2634 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2635 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2636 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2637 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2638 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2639 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2640 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2641 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2643 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2644
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2645 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2646 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2647 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2648 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2649
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2650 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2651
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2652 if ((ii < starting || (ii < ending && !NILP (end))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2653 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2654 check_sequence_range (args[0], start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2655 make_fixnum (deleted
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2656 + XFIXNUM (Flength (args[0]))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2657 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2658 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2659 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2661 sequence = list_delete_duplicates_from_end (sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2662 test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2663 test, key, start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2664 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2667 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2669 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2670
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2671 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2672 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2673 /* We know all the elements will be characters; set check_test to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2674 reflect that. This isn't useful if KEY is not #'identity, since
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2675 it may return non-characters for the elements. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2676 check_test = get_check_test_function (make_char ('a'),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2677 &test, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2678 Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2679 &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2680 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2682 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2683 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2684 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2685 Ibyte *staging = alloca_ibytes (byte_len), *staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2686 Ibyte *cursor = XSTRING_DATA (sequence), *startp = cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2687 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2688
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2689 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2690
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2691 while (cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2692 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2693 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2694 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2695 Ibyte *cursor0 = cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2696 Bytecount cursor0_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2697 Boolint delete_this = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2698
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2699 elt = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2700 INC_IBYTEPTR (cursor0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2701 cursor0_offset = cursor0 - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2702
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2703 for (jj = ii + 1; jj < ending && cursor0_offset < byte_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2704 jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2705 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2706 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2707 make_char (itext_ichar (cursor0)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2708 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2709 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2710 delete_this = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2711 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2712 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2713 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2714
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2715 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2716 cursor0 = startp + cursor0_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2717 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2718 || !valid_ibyteptr_p (cursor0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2719 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2720 mapping_interaction_error (Qdelete_duplicates,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2721 sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2722 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2724 INC_IBYTEPTR (cursor0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2725 cursor0_offset = cursor0 - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2726 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2727
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2728 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2729 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2730
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2731 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2732 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2733 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2734 mapping_interaction_error (Qdelete_duplicates, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2735 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2736
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2737 if (!delete_this)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2739 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2740 += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2742 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2743 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2744 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2745 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2746 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2747 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2749 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2750 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2751 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2752 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2754 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2755
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2756 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2757 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2758 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2759 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2760
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2761 if (0 != deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2762 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2763 sequence = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2764 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2765 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2766 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2767 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2768 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2769 Ibyte *staging = alloca_ibytes ((len = string_char_length (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2770 * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2771 Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2772 Ibyte *endp = startp + XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2773 struct Lisp_Bit_Vector *deleting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2774 = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2775 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2776 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2777 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2778
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2779 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2781 /* For the from_end t case; transform contents to an array with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2782 elements addressable in constant time, use the same algorithm
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2783 as for vectors. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2784 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2785 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2786 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2787
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2788 while (startp < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2789 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2790 itext_copy_ichar (startp, staging + (ii * MAX_ICHAR_LEN));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2791 INC_IBYTEPTR (startp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2792 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2793 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2794
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2795 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2796
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2797 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2798
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2799 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2800 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2801 elt = KEY (key, make_char (itext_ichar (staging +
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2802 (ii * MAX_ICHAR_LEN))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2803 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2804 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2805 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2806 make_char (itext_ichar
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2807 (staging + (jj * MAX_ICHAR_LEN))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2808 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2809 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2810 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2811 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2812 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2813 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2814 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2815 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2817 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2819 if (0 != deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2820 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2821 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2823 for (ii = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2824 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2825 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2826 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2827 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2828 += itext_copy_ichar (startp, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2829 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2831 INC_IBYTEPTR (startp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2832 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2834 sequence = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2835 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2837 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2838 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2839 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2840 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2841 Lisp_Object *content = XVECTOR_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2842 struct Lisp_Bit_Vector *deleting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2843 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2844
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2845 len = XVECTOR_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2846 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2847
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2848 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2849 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2850 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2851 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2852 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2853 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2854 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2856 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2857
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2858 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2859
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2860 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2861 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2862 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2863 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2864 elt = KEY (key, content[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2865
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2866 for (jj = ii + 1; jj < ending; jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2867 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2868 if (check_test (test, key, elt, content[jj])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2869 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2870 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2871 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2872 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2873 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2874 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2875 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2876 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2877 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2878 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2879 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2880 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2881 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2882 elt = KEY (key, content[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2883
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2884 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2885 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2886 if (check_test (test, key, elt, content[jj])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2887 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2888 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2889 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2890 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2891 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2892 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2893 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2894 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2895 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2897 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2898
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2899 if (deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2900 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2901 Lisp_Object res = make_vector (len - deleted, Qnil),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2902 *res_content = XVECTOR_DATA (res);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2903
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2904 for (ii = jj = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2905 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2906 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2907 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2908 res_content[jj++] = content[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2909 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2910 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2911
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2912 sequence = res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2913 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2914 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2915 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2917 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2918 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2919 /* I'm a little irritated at this. Basically, the only reasonable
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2920 thing delete-duplicates should do if handed a bit vector is return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2921 something of maximum length two and minimum length 0 (because
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2922 that's the possible number of distinct elements if EQ is regarded
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2923 as identity, which it should be). But to support arbitrary TEST
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2924 and KEY arguments, which may be non-deterministic from our
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2925 perspective, we need the same algorithm as for vectors. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2926 struct Lisp_Bit_Vector *deleting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2927 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2928
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2929 len = bit_vector_length (bv);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2930
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2931 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2932 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2933 /* We know all the elements will be bits; set check_test to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2934 reflect that. This isn't useful if KEY is not #'identity, since
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2935 it may return non-bits for the elements. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2936 check_test = get_check_test_function (Qzero, &test, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2937 Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2938 &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2939 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2940
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2941 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2942
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2943 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2944 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2945 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2946 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2947 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2948 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2949 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2951 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2952
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2953 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2954
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2955 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2956 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2957 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2958 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2959 elt = KEY (key, make_fixnum (bit_vector_bit (bv, ii)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2961 for (jj = ii + 1; jj < ending; jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2963 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2964 make_fixnum (bit_vector_bit (bv, jj)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2965 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2966 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2967 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2968 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2969 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2970 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2971 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2972 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2973 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2974 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2975 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2976 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2977 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2978 elt = KEY (key, make_fixnum (bit_vector_bit (bv, ii)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2979
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2980 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2981 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2982 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2983 make_fixnum (bit_vector_bit (bv, jj)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2984 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2985 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2986 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2987 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2988 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2989 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2990 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2992 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2993
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2994 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2995
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2996 if (deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2998 Lisp_Object res = make_bit_vector (len - deleted, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2999 Lisp_Bit_Vector *resbv = XBIT_VECTOR (res);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3000
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3001 for (ii = jj = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3002 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3003 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3004 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3005 set_bit_vector_bit (resbv, jj++, bit_vector_bit (bv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3007 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3008
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3009 sequence = res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3010 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3013 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3014 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3016 DEFUN ("remove-duplicates", Fremove_duplicates, 1, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3017 Remove duplicate elements from SEQUENCE, non-destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3018
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3019 If there are no duplicate elements in SEQUENCE, return it unmodified;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3020 otherwise, return a new object. If SEQUENCE is a list, the new object may
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3021 share list structure with SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3022
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3023 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3025 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3026 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3027 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3028 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3029 Lisp_Object sequence = args[0], keyed, positioned = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3030 Lisp_Object result = sequence, result_tail = result, cursor = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3031 Lisp_Object cons_with_shared_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3032 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3033 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3034 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3035 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3036
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3037 PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3038 (test, key, test_not, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3039 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3041 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3043 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3045 return Fdelete_duplicates (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3046 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3047
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3048 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3049 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3050
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3051 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3052 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3053 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3054 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3055 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3056
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3057 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3058 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3059 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3060 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3061
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3062 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3063 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3064
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3065 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3066 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3067 Lisp_Object ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3068
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3069 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3070
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3071 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3072 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3073 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3074 if (starting <= ii && ii <= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3075 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3076 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3077 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3078 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3079 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3080 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3081 make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3082 - (ii + 1), 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3083 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3084 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3085 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3086 sequence = result = result_tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3087 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3088 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3089 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3090 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3091 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3092 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3093 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3094 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3095 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3096 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3097
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3098 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3099 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3100 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3101 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3102
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3103 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3104 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3105 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3106 if (!(starting <= ii && ii <= ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3107 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3108 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3109 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3110 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3111
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3112 /* For this algorithm, each time we encounter an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3113 removed, copy the output list from the tail beyond the last
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3114 removed cons to this one. Otherwise, the tail of the output list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3115 is shared with the input list, which is OK. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3116
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3117 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3118 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3119 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3120 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3121 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3122 make_fixnum (max (starting - (ii + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3123 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3124 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3125 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3127 if (EQ (result, sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3128 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3129 result = cons_with_shared_tail
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3130 = Fcons (XCAR (sequence), XCDR (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3131 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3132
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3133 result_tail = cons_with_shared_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3134 cursor = XCDR (cons_with_shared_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3135
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3136 while (!EQ (cursor, tail) && !NILP (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3137 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3138 XSETCDR (result_tail, Fcons (XCAR (cursor), Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3139 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3140 cursor = XCDR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3142
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3143 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3144 cons_with_shared_tail = result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3146
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3147 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3148 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3149 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3150 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3151
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3152 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3153
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3154 if ((ii < starting || (ii < ending && !NILP (end))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3155 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3156 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3157 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3158 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3159 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3161 result = list_delete_duplicates_from_end (sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3162 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3163 start, end, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3164 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3165
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3166 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3168 #undef KEY
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3169
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3170 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3171 Reverse SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3172
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3173 Return the beginning of the reversed sequence, which will be a distinct Lisp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3174 object if SEQUENCE is a list with length greater than one. See also
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3175 `reverse', the non-destructive version of this function.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3176 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3177 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3178 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3179 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3181 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3182 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3183 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3184 Lisp_Object prev = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3185 Lisp_Object tail = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3186
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3187 /* We gcpro our args; see `nconc' */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3188 GCPRO2 (prev, tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3189 while (!NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3190 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3191 REGISTER Lisp_Object next;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3192 CONCHECK_CONS (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3193 next = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3194 XCDR (tail) = prev;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3195 prev = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3196 tail = next;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3197 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3198 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3199 return prev;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3201 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3202 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3203 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3204 Elemcount half = length / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3205 Lisp_Object swap = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3206 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3207
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3208 while (ii > half)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3209 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3210 swap = XVECTOR_DATA (sequence) [length - ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3211 XVECTOR_DATA (sequence) [length - ii]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3212 = XVECTOR_DATA (sequence) [ii - 1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3213 XVECTOR_DATA (sequence) [ii - 1] = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3214 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3215 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3216 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3217 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3218 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3219 Elemcount length = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3220 Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3221 Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3222
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3223 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3224 while (cursor < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3225 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3226 staging_end -= itext_ichar_len (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3227 itext_copy_ichar (cursor, staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3228 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3229 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3230
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3231 assert (staging == staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3232
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3233 memcpy (XSTRING_DATA (sequence), staging, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3234 init_string_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3235 bump_string_modiff (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3236 sledgehammer_check_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3237 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3238 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3239 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3240 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3241 Elemcount length = bit_vector_length (bv), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3242 Elemcount half = length / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3243 int swap = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3244
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3245 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3246 while (ii > half)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3248 swap = bit_vector_bit (bv, length - ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3249 set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3250 set_bit_vector_bit (bv, ii - 1, swap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3251 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3252 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3253 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3254 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3255 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3256 assert (NILP (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3257 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3258
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3259 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3262 DEFUN ("reverse", Freverse, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3263 Reverse SEQUENCE, copying. Return the reversed sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3264 See also the function `nreverse', which is used more often.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3265 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3266 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3267 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3268 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3269
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3270 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3271
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3272 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3273 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3274 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3275 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3276 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3277 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3278 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3279 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3280 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3281 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3282 Lisp_Object *staging = alloca_array (Lisp_Object, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3283
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3284 while (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3286 staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3287 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3288 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3289
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3290 result = Fvector (length, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3291 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3292 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3293 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3294 Elemcount length = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3295 Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3296 Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3298 while (cursor < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3300 staging_end -= itext_ichar_len (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3301 itext_copy_ichar (cursor, staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3302 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3303 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3304
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3305 assert (staging == staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3306
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3307 result = make_string (staging, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3308 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3309 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3310 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3311 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence), *res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3312 Elemcount length = bit_vector_length (bv), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3314 result = make_bit_vector (length, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3315 res = XBIT_VECTOR (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3316
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3317 while (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3318 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3319 set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3320 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3321 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3323 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3324 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3325 assert (NILP (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3326 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3327
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3328 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3329 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3331 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3332 list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3333 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3334 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3335 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3336 Lisp_Object value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3337 Lisp_Object tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3338 Lisp_Object tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3339 Lisp_Object l1, l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3340 Lisp_Object tortoises[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3341 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3342 int l1_count = 0, l2_count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3343
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3344 l1 = org_l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3345 l2 = org_l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3346 tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3347 value = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3348 tortoises[0] = org_l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3349 tortoises[1] = org_l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3350
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3351 /* It is sufficient to protect org_l1 and org_l2. When l1 and l2 are
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3352 updated, we copy the new values back into the org_ vars. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3353
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3354 GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3355 gcpro5.nvars = 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3356
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3357 while (1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3359 if (NILP (l1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3360 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3361 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3362 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3363 return l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3364 Fsetcdr (tail, l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3365 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3366 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3367 if (NILP (l2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3368 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3369 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3370 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3371 return l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3372 Fsetcdr (tail, l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3373 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3374 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3376 if (check_merge (predicate, key, Fcar (l2), Fcar (l1)) == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3377 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3378 tem = l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3379 l1 = Fcdr (l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3380 org_l1 = l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3382 if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3384 if (l1_count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3385 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3386 if (!CONSP (tortoises[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3387 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3388 mapping_interaction_error (Qmerge, tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3389 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3391 tortoises[0] = XCDR (tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3394 if (EQ (org_l1, tortoises[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3395 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3396 signal_circular_list_error (org_l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3397 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3398 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3399 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3400 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3401 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3402 tem = l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3403 l2 = Fcdr (l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3404 org_l2 = l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3405
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3406 if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3407 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3408 if (l2_count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3409 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3410 if (!CONSP (tortoises[1]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3411 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3412 mapping_interaction_error (Qmerge, tortoises[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3413 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3414
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3415 tortoises[1] = XCDR (tortoises[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3416 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3417
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3418 if (EQ (org_l2, tortoises[1]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3419 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3420 signal_circular_list_error (org_l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3421 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3422 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3423 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3424
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3425 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3426 value = tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3427 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3428 Fsetcdr (tail, tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3429
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3430 tail = tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3431 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3432 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3433
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3434 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3435 array_merge (Lisp_Object *dest, Elemcount dest_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3436 Lisp_Object *front, Elemcount front_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3437 Lisp_Object *back, Elemcount back_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3438 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3439 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3440 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3441 Elemcount ii, fronting, backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3442 Lisp_Object *front_staging = front;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3443 Lisp_Object *back_staging = back;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3444 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3445
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3446 assert (dest_len == (back_len + front_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3447
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3448 if (0 == dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3450 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3452
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3453 if (front >= dest && front < (dest + dest_len))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3454 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3455 front_staging = alloca_array (Lisp_Object, front_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3456
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3457 for (ii = 0; ii < front_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3458 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3459 front_staging[ii] = front[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3460 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3461 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3462
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3463 if (back >= dest && back < (dest + dest_len))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3464 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3465 back_staging = alloca_array (Lisp_Object, back_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3467 for (ii = 0; ii < back_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3468 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3469 back_staging[ii] = back[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3470 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3473 GCPRO2 (front_staging[0], back_staging[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3474 gcpro1.nvars = front_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3475 gcpro2.nvars = back_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3477 for (ii = fronting = backing = 0; ii < dest_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3478 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3479 if (fronting >= front_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3480 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3481 while (ii < dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3482 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3483 dest[ii] = back_staging[backing];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3484 ++ii, ++backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3485 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3486 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3487 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3488 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3489
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3490 if (backing >= back_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3491 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3492 while (ii < dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3493 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3494 dest[ii] = front_staging[fronting];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3495 ++ii, ++fronting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3496 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3497 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3498 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3500
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3501 if (check_merge (predicate, key, back_staging[backing],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3502 front_staging[fronting]) == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3503 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3504 dest[ii] = front_staging[fronting];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3505 ++fronting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3506 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3507 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3508 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3509 dest[ii] = back_staging[backing];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3510 ++backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3511 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3512 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3513
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3514 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3515 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3516
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3517 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3518 list_array_merge_into_list (Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3519 Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3520 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3521 Lisp_Object predicate, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3522 Boolint reverse_order)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3523 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3524 Lisp_Object tail = Qnil, value = Qnil, tortoise = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3525 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3526 Elemcount array_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3527 int looped = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3528
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3529 GCPRO4 (list, tail, value, tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3530
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3531 while (1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3532 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3533 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3534 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3535 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3537 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3538 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3539 return Flist (array_len, array);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3540 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3541
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3542 Fsetcdr (tail, Flist (array_len - array_index, array + array_index));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3543 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3544 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3546 if (array_index >= array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3547 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3548 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3549 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3550 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3551 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3552 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3553
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3554 Fsetcdr (tail, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3555 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3556 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3558
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3559 if (reverse_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3560 check_merge (predicate, key, Fcar (list), array [array_index])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3561 : !check_merge (predicate, key, array [array_index], Fcar (list)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3562 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3563 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3564 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3565 value = tail = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3566 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3567 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3569 Fsetcdr (tail, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3570 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3571 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3572
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3573 list = Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3574 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3575 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3576 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3577 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3578 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3579 value = tail = Fcons (array [array_index], Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3580 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3581 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3582 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3583 Fsetcdr (tail, Fcons (array [array_index], tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3584 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3585 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3586 ++array_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3587 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3589 if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3590 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3591 if (looped & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3592 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3593 tortoise = XCDR (tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3594 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3595
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3596 if (EQ (list, tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3597 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3598 signal_circular_list_error (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3599 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3600 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3601 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3604 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3605 list_list_merge_into_array (Lisp_Object *output, Elemcount output_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3606 Lisp_Object list_one, Lisp_Object list_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3607 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3608 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3609 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3610 Elemcount output_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3611
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3612 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3613 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3614 if (NILP (list_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3615 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3616 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3617 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3618 output [output_index] = Fcar (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3619 list_two = Fcdr (list_two), ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3620 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3621 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3622 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3623
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3624 if (NILP (list_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3626 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3628 output [output_index] = Fcar (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3629 list_one = Fcdr (list_one), ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3630 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3631 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3632 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3633
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3634 if (check_merge (predicate, key, Fcar (list_two), Fcar (list_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3635 == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3636 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3637 output [output_index] = XCAR (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3638 list_one = XCDR (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3640 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3641 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3642 output [output_index] = XCAR (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3643 list_two = XCDR (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3644 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3645
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3646 ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3647
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3648 /* No need to check for circularity. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3649 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3650 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3651
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3652 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3653 list_array_merge_into_array (Lisp_Object *output, Elemcount output_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3654 Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3655 Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3656 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3657 Lisp_Object predicate, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3658 Boolint reverse_order)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3659 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3660 Elemcount output_index = 0, array_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3661
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3662 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3663 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3664 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3666 if (array_len - array_index != output_len - output_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3667 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3668 mapping_interaction_error (Qmerge, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3669 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3670
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3671 while (array_index < array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3672 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3673 output [output_index++] = array [array_index++];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3674 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3675
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3676 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3677 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3678
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3679 if (array_index >= array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3680 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3681 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3682 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3683 output [output_index++] = Fcar (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3684 list = Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3685 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3686
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3687 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3688 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3689
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3690 if (reverse_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3691 check_merge (predicate, key, Fcar (list), array [array_index]) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3692 !check_merge (predicate, key, array [array_index], Fcar (list)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3693 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3694 output [output_index] = XCAR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3695 list = XCDR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3696 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3697 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3698 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3699 output [output_index] = array [array_index];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3700 ++array_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3701 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3702
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3703 ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3705 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3706
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3707 #define STRING_DATA_TO_OBJECT_ARRAY(strdata, c_array, counter, len) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3708 do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3709 c_array = alloca_array (Lisp_Object, len); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3710 for (counter = 0; counter < len; ++counter) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3711 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3712 c_array[counter] = make_char (itext_ichar (strdata)); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3713 INC_IBYTEPTR (strdata); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3714 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3715 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3717 #define BIT_VECTOR_TO_OBJECT_ARRAY(v, c_array, counter, len) do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3718 c_array = alloca_array (Lisp_Object, len); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3719 for (counter = 0; counter < len; ++counter) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3720 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3721 c_array[counter] = make_fixnum (bit_vector_bit (v, counter)); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3722 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3723 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3724
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3725 DEFUN ("merge", Fmerge, 4, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3726 Destructively merge SEQUENCE-ONE and SEQUENCE-TWO, producing a new sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3727
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3728 TYPE is the type of sequence to return. PREDICATE is a `less-than'
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3729 predicate on the elements.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3730
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3731 Optional keyword argument KEY is a function used to extract an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3732 used for comparison from each element of SEQUENCE-ONE and SEQUENCE-TWO.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3733
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3734 arguments: (TYPE SEQUENCE-ONE SEQUENCE-TWO 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
3735 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3736 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3737 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3738 Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3739 predicate = args[3], result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3740 check_test_func_t check_merge = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3742 PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3743
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3744 CHECK_SEQUENCE (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3745 CHECK_SEQUENCE (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3747 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3749 check_merge = get_merge_predicate (predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3750
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3751 if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3752 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3753 if (NILP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3754 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3755 result = Fappend (2, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3756 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3757 else if (NILP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3758 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3759 args[3] = Qnil; /* Overwriting PREDICATE, and losing its GC
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3760 protection, but that doesn't matter. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3761 result = Fappend (2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3762 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3763 else if (CONSP (sequence_one) && CONSP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3764 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3765 result = list_merge (sequence_one, sequence_two, check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3766 predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3767 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3768 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3769 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3770 Lisp_Object *array_storage, swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3771 Elemcount array_length, i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3772 Boolint reverse_order = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3774 if (!CONSP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3775 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3776 /* Make sequence_one the cons, sequence_two the array: */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3777 swap = sequence_one;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3778 sequence_one = sequence_two;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3779 sequence_two = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3780 reverse_order = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3781 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3782
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3783 if (VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3784 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3785 array_storage = XVECTOR_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3786 array_length = XVECTOR_LENGTH (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3787 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3788 else if (STRINGP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3789 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3790 Ibyte *strdata = XSTRING_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3791 array_length = string_char_length (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3792 /* No need to GCPRO, characters are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3793 STRING_DATA_TO_OBJECT_ARRAY (strdata, array_storage, i,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3794 array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3796 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3797 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3798 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3799 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3800 array_length = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3801 /* No need to GCPRO, fixnums are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3802 BIT_VECTOR_TO_OBJECT_ARRAY (v, array_storage, i, array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3804
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3805 result = list_array_merge_into_list (sequence_one,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3806 array_storage, array_length,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3807 check_merge, predicate, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3808 reverse_order);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3809 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3810 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3811 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3812 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3813 Elemcount sequence_one_len = XFIXNUM (Flength (sequence_one)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3814 sequence_two_len = XFIXNUM (Flength (sequence_two)), i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3815 Elemcount output_len = 1 + sequence_one_len + sequence_two_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3816 Lisp_Object *output = alloca_array (Lisp_Object, output_len),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3817 *sequence_one_storage = NULL, *sequence_two_storage = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3818 Boolint do_coerce = !(EQ (type, Qvector) || EQ (type, Qstring)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3819 || EQ (type, Qbit_vector) || EQ (type, Qlist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3820 Ibyte *strdata = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3821 Lisp_Bit_Vector *v = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3822 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3823
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3824 output[0] = do_coerce ? Qlist : type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3825 for (i = 1; i < output_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3826 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3827 output[i] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3828 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3829
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3830 GCPRO1 (output[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3831 gcpro1.nvars = output_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3832
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3833 if (VECTORP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3834 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3835 sequence_one_storage = XVECTOR_DATA (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3837 else if (STRINGP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3838 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3839 strdata = XSTRING_DATA (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3840 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3841 i, sequence_one_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3842 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3843 else if (BIT_VECTORP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3845 v = XBIT_VECTOR (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3846 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3847 i, sequence_one_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3848 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3849
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3850 if (VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3851 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3852 sequence_two_storage = XVECTOR_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3853 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3854 else if (STRINGP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3855 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3856 strdata = XSTRING_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3857 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3858 i, sequence_two_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3859 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3860 else if (BIT_VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3861 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3862 v = XBIT_VECTOR (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3863 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3864 i, sequence_two_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3865 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3866
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3867 if (LISTP (sequence_one) && LISTP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3868 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3869 list_list_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3870 sequence_one, sequence_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3871 check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3872 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3873 else if (LISTP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3874 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3875 list_array_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3876 sequence_one,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3877 sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3878 sequence_two_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3879 check_merge, predicate, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3880 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3881 else if (LISTP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3882 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3883 list_array_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3884 sequence_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3885 sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3886 sequence_one_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3887 check_merge, predicate, key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3889 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3890 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3891 array_merge (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3892 sequence_one_storage, sequence_one_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3893 sequence_two_storage, sequence_two_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3894 check_merge, predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3895 key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3896 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3897
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3898 result = Ffuncall (output_len, output);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3899
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3900 if (do_coerce)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3901 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3902 result = call2 (Qcoerce, result, type);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3903 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3905 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3906 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3908 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3909 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3910
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3911 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3912 list_sort (Lisp_Object list, check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3913 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3914 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3915 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3916 Lisp_Object back, tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3917 Lisp_Object front = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3918 Lisp_Object len = Flength (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3919
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3920 if (XFIXNUM (len) < 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3921 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3922
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3923 len = make_fixnum (XFIXNUM (len) / 2 - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3924 tem = Fnthcdr (len, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3925 back = Fcdr (tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3926 Fsetcdr (tem, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3927
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3928 GCPRO4 (front, back, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3929 front = list_sort (front, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3930 back = list_sort (back, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3931
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3932 RETURN_UNGCPRO (list_merge (front, back, check_merge, predicate, key));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3933 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3935 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3936 array_sort (Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3937 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3938 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3939 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3940 Elemcount split;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3941
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3942 if (array_len < 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3943 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3944
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3945 split = array_len / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3947 array_sort (array, split, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3948 array_sort (array + split, array_len - split, check_merge, predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3949 key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3950 array_merge (array, array_len, array, split, array + split,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3951 array_len - split, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3952 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3954 DEFUN ("sort*", FsortX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3955 Sort SEQUENCE, comparing elements using PREDICATE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3956 Returns the sorted sequence. SEQUENCE is modified by side effect.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3957
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3958 PREDICATE is called with two elements of SEQUENCE, and should return t if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3959 the first element is `less' than the second.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3961 Optional keyword argument KEY is a function used to extract an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3962 used for comparison from each element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3963
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3964 In this implementation, sorting is always stable; but call `stable-sort' if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3965 this stability is important to you, other implementations may not make the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3966 same guarantees.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3968 arguments: (SEQUENCE PREDICATE &key (KEY #'IDENTITY))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3969 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3970 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3971 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3972 Lisp_Object sequence = args[0], predicate = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3973 Lisp_Object *sequence_carray;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3974 check_test_func_t check_merge = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3975 Elemcount sequence_len, i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3976
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3977 PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3978
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3979 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3980
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3981 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3982
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3983 check_merge = get_merge_predicate (predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3984
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3985 if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3986 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3987 sequence = list_sort (sequence, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3988 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3989 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3990 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3991 array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3992 check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3993 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3994 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3995 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3996 Ibyte *strdata = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3997
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3998 sequence_len = string_char_length (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3999
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4000 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4001
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4002 /* No GCPRO necessary, characters are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4003 array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4004
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4005 strdata = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4006
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4007 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4008 for (i = 0; i < sequence_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4009 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4010 strdata += set_itext_ichar (strdata, XCHAR (sequence_carray[i]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4013 init_string_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4014 bump_string_modiff (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4015 sledgehammer_check_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4016 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4017 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4018 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4019 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4020 sequence_len = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4021
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4022 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4023
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4024 /* No GCPRO necessary, bits are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4025 array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4026
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4027 for (i = 0; i < sequence_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4028 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4029 set_bit_vector_bit (v, i, XFIXNUM (sequence_carray [i]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4030 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4031 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4032
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4033 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4034 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4036
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4037 static Lisp_Object replace_string_range_1 (Lisp_Object dest,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4038 Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4039 Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4040 const Ibyte *source,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4041 const Ibyte *source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4042 Lisp_Object item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4043
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4044 /* Fill the substring of DEST beginning at START and ending before END with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4045 the character ITEM. If DEST does not have sufficient space for END -
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4046 START characters at START, write as many as is possible without changing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4047 the character length of DEST. Update the string modification flag and do
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4048 any sledgehammer checks we have turned on.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4049
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4050 START must be a Lisp integer. END can be nil, indicating the length of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4051 string, or a Lisp integer. The condition (<= 0 START END (length DEST))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4052 must hold, or fill_string_range() will signal an error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4053 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4054 fill_string_range (Lisp_Object dest, Lisp_Object item, Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4055 Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4056 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4057 return replace_string_range_1 (dest, start, end, NULL, NULL, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4058 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4059
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4060 DEFUN ("fill", Ffill, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4061 Destructively modify SEQUENCE by replacing each element with ITEM.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4062 SEQUENCE is a list, vector, bit vector, or string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4063
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4064 Optional keyword START is the index of the first element of SEQUENCE
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4065 to be modified, and defaults to zero. Optional keyword END is the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4066 exclusive upper bound on the elements of SEQUENCE to be modified, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4067 defaults to the length of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4068
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4069 arguments: (SEQUENCE ITEM &key (START 0) (END (length SEQUENCE)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4070 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4071 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4072 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4073 Lisp_Object sequence = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4074 Lisp_Object item = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4075 Elemcount starting, ending = MOST_POSITIVE_FIXNUM + 1, ii, len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4076
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4077 PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4078
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4079 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4080 starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4081
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4082 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4083 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4084 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4085 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4086 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4087
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4088 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4089 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4090 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4091 CHECK_CHAR_COERCE_INT (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4092 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4093
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4094 fill_string_range (sequence, item, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4095 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4096 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4097 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4098 Lisp_Object *p = XVECTOR_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4099
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4100 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4101 len = XVECTOR_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4102
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4103 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4104 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4105
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4106 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4107 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4108 p[ii] = item;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4109 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4110 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4111 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4112 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4113 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4114 int bit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4116 CHECK_BIT (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4117 bit = XFIXNUM (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4118 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4119 len = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4120
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4121 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4122 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4123
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4124 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4126 set_bit_vector_bit (v, ii, bit);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4127 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4129 else if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4131 Elemcount counting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4132
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4133 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4134 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4135 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4136 if (counting >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4137 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4138 if (counting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4139 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4140 XSETCAR (tail, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4142 else if (counting == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4143 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4144 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4146 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4147 ++counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4148 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4149 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4150
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4151 if (counting < starting || (counting != ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4152 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4153 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4155 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4156 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4158 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4159 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4160 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4161 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4162 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4163
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4164
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4165 /* Replace the substring of DEST beginning at START and ending before END
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4166 with the text at SOURCE, which is END - START characters long and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4167 SOURCE_LIMIT - SOURCE octets long. If DEST does not have sufficient
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4168 space for END - START characters at START, write as many as is possible
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4169 without changing the length of DEST. Update the string modification flag
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4170 and do any sledgehammer checks we have turned on in this build.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4171
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4172 START must be a Lisp integer. END can be nil, indicating the length of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4173 string, or a Lisp integer. The condition (<= 0 START END (length DEST))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4174 must hold, or replace_string_range() will signal an error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4175 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4176 replace_string_range (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4177 const Ibyte *source, const Ibyte *source_limit)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4178 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4179 return replace_string_range_1 (dest, start, end, source, source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4180 Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4181 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4182
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4183 /* This is the guts of several mapping functions.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4184
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4185 Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4186 taking the elements from SEQUENCES. If VALS is non-NULL, store the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4187 results into VALS, a C array of Lisp_Objects; else, if LISP_VALS is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4188 non-nil, store the results into LISP_VALS, a sequence with sufficient
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4189 room for CALL_COUNT results (but see the documentation of SOME_OR_EVERY.)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4190 Else, do not accumulate any result.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4191
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4192 If VALS is non-NULL, NSEQUENCES is one, and SEQUENCES[0] is a cons,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4193 mapcarX will store the elements of SEQUENCES[0] in stack and GCPRO them,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4194 so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4195 mapcarX.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4196
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4197 Otherwise, mapcarX signals an invalid state error (see
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4198 mapping_interaction_error(), above) if it encounters a non-cons,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4199 non-array when traversing SEQUENCES. Common Lisp specifies in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4200 MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4201 destructively modifies SEQUENCES in a way that might affect the ongoing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4202 traversal operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4203
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4204 CALLER is a symbol describing the Lisp-visible function that was called,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4205 and any errors thrown because SEQUENCES was modified will reflect it.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4206
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4207 If CALLER is Qsome, return the (possibly multiple) values given by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4208 FUNCTION the first time it is non-nil, and abandon the iterations.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4209 LISP_VALS must be the result of calling STORE_VOID_IN_LISP on the address
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4210 of a Lisp object, and the return value will be stored at that address.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4211 If CALLER is Qevery, LISP_VALS must also reflect a pointer to a Lisp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4212 object, and Qnil will be stored at that address if FUNCTION gives nil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4213 otherwise it will be left alone. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4215 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4216 mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4217 Lisp_Object function, int nsequences, Lisp_Object *sequences,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4218 Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4219 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4220 Lisp_Object called, *args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4221 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4222 Ibyte *lisp_vals_staging = NULL, *cursor = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4223 int i, j;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4224
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4225 assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4227 args = alloca_array (Lisp_Object, nsequences + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4228 args[0] = function;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4229 for (i = 1; i <= nsequences; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4230 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4231 args[i] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4232 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4234 if (vals != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4235 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4236 GCPRO2 (args[0], vals[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4237 gcpro1.nvars = nsequences + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4238 gcpro2.nvars = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4239 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4240 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4241 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4242 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4243 gcpro1.nvars = nsequences + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4244 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4245
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4246 /* Be extra nice in the event that we've been handed one list and one
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4247 only; make it possible for FUNCTION to set cdrs not yet processed to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4248 non-cons, non-nil objects without ill-effect, if we have been handed
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4249 the stack space to do that. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4250 if (vals != NULL && 1 == nsequences && CONSP (sequences[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4251 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4252 Lisp_Object lst = sequences[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4253 Lisp_Object *val = vals;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4254 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4255 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4256 *val++ = XCAR (lst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4257 lst = XCDR (lst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4258 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4259 gcpro2.nvars = call_count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4260
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4261 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4262 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4263 args[1] = vals[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4264 vals[i] = IGNORE_MULTIPLE_VALUES (Ffuncall (nsequences + 1, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4265 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4266 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4267 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4268 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4269 enum lrecord_type lisp_vals_type = lrecord_type_symbol;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4270 Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4271 for (j = 0; j < nsequences; ++j)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4272 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4273 sequence_types[j] = XRECORD_LHEADER (sequences[j])->type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4274 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4276 if (!EQ (caller, Qsome) && !EQ (caller, Qevery))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4278 assert (LRECORDP (lisp_vals));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4279
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4280 lisp_vals_type
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4281 = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4282
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4283 if (lrecord_type_string == lisp_vals_type)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4284 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4285 lisp_vals_staging = cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4286 = alloca_ibytes (call_count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4287 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4288 else if (ARRAYP (lisp_vals))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4289 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4290 CHECK_LISP_WRITEABLE (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4291 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4292 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4293
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4294 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4295 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4296 for (j = 0; j < nsequences; ++j)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4297 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4298 switch (sequence_types[j])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4300 case lrecord_type_cons:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4301 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4302 if (!CONSP (sequences[j]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4303 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4304 /* This means FUNCTION has messed around with a cons
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4305 in one of the sequences, since we checked the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4306 type (CHECK_SEQUENCE()) and the length and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4307 structure (with Flength()) correctly in our
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4308 callers. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4309 mapping_interaction_error (caller, sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4310 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4311 args[j + 1] = XCAR (sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4312 sequences[j] = XCDR (sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4313 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4314 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4315 case lrecord_type_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4316 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4317 args[j + 1] = XVECTOR_DATA (sequences[j])[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4318 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4319 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4320 case lrecord_type_string:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4321 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4322 args[j + 1] = make_char (string_ichar (sequences[j], i));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4323 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4324 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4325 case lrecord_type_bit_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4326 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4327 args[j + 1]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4328 = make_fixnum (bit_vector_bit (XBIT_VECTOR (sequences[j]),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4329 i));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4330 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4331 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4332 default:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4333 ABORT();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4334 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4335 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4336 called = Ffuncall (nsequences + 1, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4337 if (vals != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4338 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4339 vals[i] = IGNORE_MULTIPLE_VALUES (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4340 gcpro2.nvars += 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4341 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4342 else if (EQ (Qsome, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4344 if (!NILP (IGNORE_MULTIPLE_VALUES (called)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4345 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4346 Lisp_Object *result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4347 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4348 *result = called;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4349 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4350 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4351 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4352 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4353 else if (EQ (Qevery, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4354 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4355 if (NILP (IGNORE_MULTIPLE_VALUES (called)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4356 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4357 Lisp_Object *result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4358 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4359 *result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4360 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4361 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4363 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4364 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4365 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4366 called = IGNORE_MULTIPLE_VALUES (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4367 switch (lisp_vals_type)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4368 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4369 case lrecord_type_symbol:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4370 /* Discard the result of funcall. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4371 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4372 case lrecord_type_cons:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4373 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4374 if (!CONSP (lisp_vals))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4375 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4376 /* If FUNCTION has inserted a non-cons non-nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4377 cdr into the list before we've processed the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4378 relevant part, error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4379 mapping_interaction_error (caller, lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4380 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4381 XSETCAR (lisp_vals, called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4382 lisp_vals = XCDR (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4383 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4384 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4385 case lrecord_type_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4386 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4387 i < XVECTOR_LENGTH (lisp_vals) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4388 (XVECTOR_DATA (lisp_vals)[i] = called) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4389 /* Let #'aset error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4390 Faset (lisp_vals, make_fixnum (i), called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4391 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4393 case lrecord_type_string:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4395 CHECK_CHAR_COERCE_INT (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4396 cursor += set_itext_ichar (cursor, XCHAR (called));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4397 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4398 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4399 case lrecord_type_bit_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4401 (BITP (called) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4402 i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4403 set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4404 XFIXNUM (called)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4405 (void) Faset (lisp_vals, make_fixnum (i), called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4406 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4407 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4408 default:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4409 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4410 ABORT();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4411 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4412 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4413 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4414 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4417 if (lisp_vals_staging != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4418 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4419 CHECK_LISP_WRITEABLE (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4420 replace_string_range (lisp_vals, Qzero, make_fixnum (call_count),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4421 lisp_vals_staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4422 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4423 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4424
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4425 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4426 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4427
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4428 /* Given NSEQUENCES objects at the address pointed to by SEQUENCES, return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4429 the length of the shortest sequence. Error if all are circular, or if any
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4430 one of them is not a sequence. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4431 static Elemcount
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4432 shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4433 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4434 Elemcount len = 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4435 Lisp_Object length = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4436 int i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4437
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4438 for (i = 0; i < nsequences; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4439 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4440 if (CONSP (sequences[i]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4441 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4442 length = Flist_length (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4443 if (!NILP (length))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4444 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4445 len = min (len, XFIXNUM (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4446 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4447 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4448 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4450 CHECK_SEQUENCE (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4451 length = Flength (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4452 len = min (len, XFIXNUM (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4453 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4454 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4455
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4456 if (len == 1 + MOST_POSITIVE_FIXNUM)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4458 signal_circular_list_error (sequences[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4461 return len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4462 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4463
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4464 DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4465 Call FUNCTION on each element of SEQUENCE, and concat results to a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4466 Between each pair of results, insert SEPARATOR.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4467
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4468 Each result, and SEPARATOR, should be strings. Thus, using " " as SEPARATOR
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4469 results in spaces between the values returned by FUNCTION. SEQUENCE itself
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4470 may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4471
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4472 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4473 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4474 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4475 `mapconcat' will give up once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4477 arguments: (FUNCTION SEQUENCE SEPARATOR &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4478 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4479 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4480 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4481 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4482 Lisp_Object sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4483 Lisp_Object separator = args[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4484 Elemcount len = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4485 Lisp_Object *args0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4486 EMACS_INT i, nargs0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4487
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4488 args[2] = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4489 args[1] = separator;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4490
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4491 len = shortest_length_among_sequences (nargs - 2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4492
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4493 if (len == 0) return build_ascstring ("");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4494
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4495 nargs0 = len + len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4496 args0 = alloca_array (Lisp_Object, nargs0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4498 /* Special-case this, it's very common and doesn't require any
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4499 funcalls. Upside of doing it here, instead of cl-macs.el: no consing,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4500 apart from the final string, we allocate everything on the stack. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4501 if (EQ (function, Qidentity) && 3 == nargs && CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4502 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4503 for (i = 0; i < len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4504 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4505 args0[i] = XCAR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4506 sequence = XCDR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4507 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4508 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4509 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4510 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4511 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4512 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4513
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4514 for (i = len - 1; i >= 0; i--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4515 args0[i + i] = args0[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4516
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4517 for (i = 1; i < nargs0; i += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4518 args0[i] = separator;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4519
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4520 return Fconcat (nargs0, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4521 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4522
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4523 DEFUN ("mapcar*", FmapcarX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4524 Call FUNCTION on each element of SEQUENCE; return a list of the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4525 The result is a list of the same length as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4526 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4527
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4528 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4529 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4530 from each sequence will be used each time FUNCTION is called, and `mapcar'
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4531 stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4532
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4533 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4534 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4535 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4536 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4537 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4538 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4539 Lisp_Object *args0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4541 args0 = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4542 mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4543
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4544 return Flist ((int) len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4545 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4546
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4547 DEFUN ("mapvector", Fmapvector, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4548 Call FUNCTION on each element of SEQUENCE; return a vector of the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4549 The result is a vector of the same length as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4550 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4551
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4552 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4553 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4554 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4555 `mapvector' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4556
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4557 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4558 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4559 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4560 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4561 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4562 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4563 Lisp_Object result = make_vector (len, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4565 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4566 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4567 /* Don't pass result as the lisp_object argument, we want mapcarX to protect
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4568 a single list argument's elements from being garbage-collected. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4569 mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4570 Qmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4571 RETURN_UNGCPRO (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4572 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4574 DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4575 Call FUNCTION on each element of SEQUENCE; chain the results together.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4576
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4577 FUNCTION must normally return a list; the results will be concatenated
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4578 together using `nconc'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4580 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4581 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4582 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4583 `mapcan' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4584
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4585 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4586 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4587 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4589 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4590 Lisp_Object function = args[0], *result = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4591
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4592 mapcarX (len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4593
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4594 /* #'nconc GCPROs its args in case of signals and error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4595 return Fnconc (len, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4596 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4597
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4598 DEFUN ("mapc", Fmapc, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4599 Call FUNCTION on each element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4600
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4601 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4602 This function is like `mapcar' but does not accumulate the results,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4603 which is more efficient if you do not use the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4604
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4605 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4606 there are SEQUENCES, plus one for the elements from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4607 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4608 `mapc' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4609
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4610 Return SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4611
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4612 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4613 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4614 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4615 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4616 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4617 Lisp_Object sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4618 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4619 /* We need to GCPRO sequence, because mapcarX will modify the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4620 elements of the args array handed to it, and this may involve
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4621 elements of sequence getting garbage collected. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4622 GCPRO1 (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4623 mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4624 RETURN_UNGCPRO (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4627 DEFUN ("map", Fmap, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4628 Map FUNCTION across one or more sequences, returning a sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4629
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4630 TYPE is the sequence type to return, FUNCTION is the function, SEQUENCE is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4631 the first argument sequence, SEQUENCES are the other argument sequences.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4632
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4633 FUNCTION will be called with (1+ (length SEQUENCES)) arguments, and must be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4634 capable of accepting this number of arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4635
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4636 Certain TYPEs are recognised internally by `map', but others are not, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4637 `coerce' may throw an error on an attempt to convert to a TYPE it does not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4638 understand. A null TYPE means do not accumulate any values.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4639
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4640 arguments: (TYPE FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4641 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4642 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4643 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4644 Lisp_Object type = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4645 Lisp_Object function = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4646 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4647 Lisp_Object *args0 = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4648 Elemcount len = shortest_length_among_sequences (nargs - 2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4649 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4651 if (!NILP (type))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4653 args0 = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4655
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4656 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4657
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4658 if (EQ (type, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4659 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4660 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4661 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4662
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4663 if (EQ (type, Qvector) || EQ (type, Qarray))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4664 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4665 result = Fvector (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4667 else if (EQ (type, Qstring))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4669 result = Fstring (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4670 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4671 else if (EQ (type, Qlist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4672 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4673 result = Flist (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4674 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4675 else if (EQ (type, Qbit_vector))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4676 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4677 result = Fbit_vector (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4678 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4679 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4680 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4681 result = Flist (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4682 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4683 result = call2 (Qcoerce, result, type);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4684 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4685 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4686
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4687 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4688 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4689
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4690 DEFUN ("map-into", Fmap_into, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4691 Modify RESULT-SEQUENCE using the return values of FUNCTION on SEQUENCES.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4692
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4693 RESULT-SEQUENCE and SEQUENCES can be lists or arrays.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4695 FUNCTION must accept at least as many arguments as there are SEQUENCES
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4696 \(possibly zero). If RESULT-SEQUENCE and the elements of SEQUENCES are not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4697 the same length, stop when the shortest is exhausted; any elements of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4698 RESULT-SEQUENCE beyond that are unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4700 Return RESULT-SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4701
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4702 arguments: (RESULT-SEQUENCE FUNCTION &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4703 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4704 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4705 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4706 Elemcount len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4707 Lisp_Object result_sequence = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4708 Lisp_Object function = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4709
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4710 args[0] = function;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4711 args[1] = result_sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4712
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4713 len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4714
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4715 mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4716 Qmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4718 return result_sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4719 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4721 DEFUN ("some", Fsome, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4722 Return true if PREDICATE gives non-nil for an element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4724 If so, return the value (possibly multiple) given by PREDICATE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4725
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4726 With optional SEQUENCES, call PREDICATE each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4727 there are SEQUENCES (plus one for the element from SEQUENCE).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4728
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4729 See also `find-if', which returns the corresponding element of SEQUENCE,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4730 rather than the value given by PREDICATE, and accepts bounding index
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4731 keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4732
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4733 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4734 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4735 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4736 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4737 Lisp_Object result = Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4738 result_ptr = STORE_VOID_IN_LISP ((void *) &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4739 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4740
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4741 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4742
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4743 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4746 DEFUN ("every", Fevery, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4747 Return true if PREDICATE is true of every element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4749 With optional SEQUENCES, call PREDICATE each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4750 there are SEQUENCES (plus one for the element from SEQUENCE).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4751
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4752 In contrast to `some', `every' never returns multiple values.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4754 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4755 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4756 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4757 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4758 Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4759 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4760
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4761 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4763 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4764 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4765
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4767 DEFUN ("reduce", Freduce, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4768 Combine the elements of SEQUENCE using FUNCTION, a binary operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4769
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4770 For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4771 SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4772 in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4774 Keywords supported: :start :end :from-end :initial-value :key
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4775 See `remove*' for the meaning of :start, :end, :from-end and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4776
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4777 :initial-value specifies an element (typically an identity element, such as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4778 0) that is conceptually prepended to the sequence (or appended, when
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4779 :from-end is given).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4781 If the sequence has one element, that element is returned directly.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4782 If the sequence has no elements, :initial-value is returned if given;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4783 otherwise, FUNCTION is called with no arguments, and its result returned.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4785 arguments: (FUNCTION SEQUENCE &key (START 0) (END (length SEQUENCE)) FROM-END INITIAL-VALUE (KEY #'identity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4786 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4787 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4788 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4789 Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4790 Elemcount starting, ending = MOST_POSITIVE_FIXNUM + 1, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4791
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4792 PARSE_KEYWORDS (Freduce, nargs, args, 5,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4793 (start, end, from_end, initial_value, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4794 (start = Qzero, initial_value = Qunbound));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4796 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4797 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4798 starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4799 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4800
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4801 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4802 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4803 #define CALL2(function, accum, item) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4804 IGNORE_MULTIPLE_VALUES (call2 (function, accum, item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4805
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4806 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4807 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4808 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4809 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4810 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4812 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4813 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4814 Lisp_Vector *vv = XVECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4815 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4817 check_sequence_range (sequence, start, end, make_fixnum (vv->size));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4819 ending = min (ending, vv->size);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4820
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4821 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4823 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4824 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4825 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4827 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4829 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4831 accum = KEY (key, vv->contents[starting]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4832 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4833 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4834 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4835 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4836 accum = KEY (key, vv->contents[ending - 1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4837 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4838 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4839 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4840
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4841 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4842 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4843 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4845 accum = CALL2 (function, accum, KEY (key, vv->contents[ii]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4847 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4848 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4849 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4850 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4851 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4852 accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4853 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4854 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4856 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4857 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4858 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4859 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4860 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4861 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4862
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4863 check_sequence_range (sequence, start, end, make_fixnum (bv->size));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4864 ending = min (ending, bv->size);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4865
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4866 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4867
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4868 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4869 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4870 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4871 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4872 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4873 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4874 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4875 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4876 accum = KEY (key, make_fixnum (bit_vector_bit (bv, starting)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4877 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4878 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4879 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4881 accum = KEY (key, make_fixnum (bit_vector_bit (bv, ending - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4882 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4883 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4884 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4885
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4886 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4887 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4888 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4889 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4890 accum = CALL2 (function, accum,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4891 KEY (key, make_fixnum (bit_vector_bit (bv, ii))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4892 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4893 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4894 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4895 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4896 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4897 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4898 accum = CALL2 (function, KEY (key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4899 make_fixnum (bit_vector_bit (bv,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4900 ii))),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4901 accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4902 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4903 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4905 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4906
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4907 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4908 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4909 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4910 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4911
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4912 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4913
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4914 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4915 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4916 Bytecount byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4917 Bytecount cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4918 const Ibyte *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4919 const Ibyte *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4920
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4921 for (ii = 0; ii != starting && cursor_offset < byte_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4922 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4923 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4924 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4925 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4926
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4927 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4928 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4929 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4930 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4931 else if (ending - starting && cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4932 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4933 accum = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4934 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4935 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4936 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4937
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4938 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4939 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4941 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4942 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4944 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4945 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4946 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4948
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4949 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4950 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4951 accum = CALL2 (function, accum,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4952 KEY (key, make_char (itext_ichar (cursor))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4954 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4955 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4956
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4957 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4958 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4959 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4960 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4961 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4962
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4963 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4964 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4965 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4966 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4968 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4969 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4970 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4971 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4972 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4973 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4974 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4975 Elemcount len = string_char_length (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4976 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4977 const Ibyte *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4978
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4979 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4980 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4981 starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4982
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4983 cursor = string_char_addr (sequence, ending - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4984 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4985
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4986 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4987 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4988 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4989 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4990 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4991 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4992 accum = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4993 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4994 if (ending > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4995 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4996 cursor = XSTRING_DATA (sequence) + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4997
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4998 if (!valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4999 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5000 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5001 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5002
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5003 DEC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5004 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5005 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5007
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5008 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5009 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5010 accum = CALL2 (function, KEY (key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5011 make_char (itext_ichar (cursor))),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5012 accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5013 if (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5014 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5015 cursor = XSTRING_DATA (sequence) + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5017 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5018 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5019 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5020 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5021 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5022
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5023 DEC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5024 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5025 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5026 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5027 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5028
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5029 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5030 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5031 else if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5032 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5033 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5034 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5035 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5036
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5037 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5038
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5039 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5040 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5041 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5042 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5043 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5045 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5046 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5047 if (ii == starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5048 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5049 accum = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5050 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5051 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5052 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5053 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5054 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5055 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5056 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5057
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5058 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5059
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5060 if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5061 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5062 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5063 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5064 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5065 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5066 if (ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5067 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5068 accum = CALL2 (function, accum, KEY (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5070 else if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5071 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5072 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5073 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5074 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5075 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5076 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5077 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5078 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5079
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5080 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5081
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5082 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5083 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5084 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5085 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5086 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5087 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5088 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5089 Boolint need_accum = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5090 Lisp_Object *subsequence = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5091 Elemcount counting = 0, len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5092 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5093
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5094 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5095 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5096 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5097
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5098 /* :from-end with a list; make an alloca copy of the relevant list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5099 data, attempting to go backwards isn't worth the trouble. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5100 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5101 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5102 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5103 if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5104 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5105 subsequence = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5106 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5107 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5108 else if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5109 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5110 subsequence = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5111 need_accum = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5112 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5113
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5114 if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5115 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5116 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5117 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5118 if (counting >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5119 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5120 if (counting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5121 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5122 subsequence[ii++] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5123 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5124 else if (counting == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5126 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5127 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5129 ++counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5130 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5131 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5132
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5133 if (subsequence != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5135 len = ending - starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5136 /* If we could be sure that neither FUNCTION nor KEY modify
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5137 SEQUENCE, this wouldn't be necessary, since all the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5138 elements of SUBSEQUENCE would definitely always be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5139 reachable via SEQUENCE. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5140 GCPRO1 (subsequence[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5141 gcpro1.nvars = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5142 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5143
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5144 if (need_accum)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5145 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5146 accum = KEY (key, subsequence[len - 1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5147 --len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5148 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5149
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5150 for (ii = len; ii != 0;)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5151 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5152 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5153 accum = CALL2 (function, KEY (key, subsequence[ii]), accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5155
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5156 if (subsequence != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5158 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5159 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5160 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5161 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5162
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5163 /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5164 need to return the result of calling FUNCTION with zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5165 arguments. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5166 if (UNBOUNDP (accum))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5167 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5168 accum = IGNORE_MULTIPLE_VALUES (call0 (function));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5169 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5170
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5171 return accum;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5172 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5173
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5174 /* This function is the implementation of fill_string_range() and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5175 replace_string_range(); see the comments for those functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5176 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5177 replace_string_range_1 (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5178 const Ibyte *source, const Ibyte *source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5179 Lisp_Object item)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5180 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5181 Ibyte *destp = XSTRING_DATA (dest), *p = destp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5182 *pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5183 Bytecount prefix_bytecount, source_len = source_limit - source;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5184 Charcount ii = 0, ending, len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5185 Charcount starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5186 Elemcount delta;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5187
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5188 while (ii < starting && p < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5189 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5190 INC_IBYTEPTR (p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5191 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5192 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5193
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5194 pcursor = p;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5195
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5196 if (NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5197 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5198 while (pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5199 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5200 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5201 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5202 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5203
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5204 ending = len = ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5205 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5206 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5207 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5208 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5209 while (ii < ending && pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5210 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5211 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5212 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5213 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5214 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5215
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5216 if (pcursor == pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5217 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5218 /* We have the length, check it for our callers. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5219 check_sequence_range (dest, start, end, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5220 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5221
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5222 if (!(p == pend || p == pcursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5223 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5224 prefix_bytecount = p - destp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5225
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5226 if (!NILP (item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5227 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5228 assert (source == NULL && source_limit == NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5229 source_len = set_itext_ichar (item_buf, XCHAR (item));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5230 delta = (source_len * (ending - starting)) - (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5231 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5232 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5233 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5234 assert (source != NULL && source_limit != NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5235 delta = source_len - (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5236 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5237
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5238 if (delta)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5239 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5240 resize_string (dest, prefix_bytecount, delta);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5241 destp = XSTRING_DATA (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5242 pcursor = destp + prefix_bytecount + (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5243 p = destp + prefix_bytecount;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5244 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5245
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5246 if (CHARP (item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5248 while (starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5249 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5250 memcpy (p, item_buf, source_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5251 p += source_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5252 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5253 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5254 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5255 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5256 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5257 while (starting < ending && source < source_limit)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5258 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5259 source_len = itext_copy_ichar (source, p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5260 p += source_len, source += source_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5261 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5262 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5263
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5264 init_string_ascii_begin (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5265 bump_string_modiff (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5266 sledgehammer_check_ascii_begin (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5267 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5269 return dest;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5270 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5271
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5272 DEFUN ("replace", Freplace, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5273 Replace the elements of SEQUENCE-ONE with the elements of SEQUENCE-TWO.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5274
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5275 SEQUENCE-ONE is destructively modified, and returned. Its length is not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5276 changed.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5277
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5278 Keywords :start1 and :end1 specify a subsequence of SEQUENCE-ONE, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5279 :start2 and :end2 a subsequence of SEQUENCE-TWO. See `search' for more
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5280 information.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5281
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5282 arguments: (SEQUENCE-ONE SEQUENCE-TWO &key (START1 0) (END1 (length SEQUENCE-ONE)) (START2 0) (END2 (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
5283 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5284 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5286 Lisp_Object sequence1 = args[0], sequence2 = args[1],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5287 result = sequence1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5288 Elemcount starting1, ending1 = MOST_POSITIVE_FIXNUM + 1, starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5289 Elemcount ending2 = MOST_POSITIVE_FIXNUM + 1, counting = 0, startcounting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5290 Boolint sequence1_listp, sequence2_listp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5291 overwriting = EQ (sequence1, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5293 PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5294 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5295
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5296 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5297 CHECK_LISP_WRITEABLE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5298
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5299 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5300
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5301 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5302 starting1 = BIGNUMP (start1) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5303 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5304 starting2 = BIGNUMP (start2) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5305
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5306 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5307 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5308 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5309 ending1 = BIGNUMP (end1) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5310 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5311
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5312 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5313 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5314 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5315 ending2 = BIGNUMP (end2) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5316 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5317
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5318 sequence1_listp = LISTP (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5319 sequence2_listp = LISTP (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5320
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5321 overwriting = overwriting && starting2 <= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5322
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5323 if (sequence1_listp && !ZEROP (start1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5324 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5325 sequence1 = Fnthcdr (start1, sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5327 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5328 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5329 check_sequence_range (args[0], start1, end1, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5330 /* Give up early here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5331 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5332 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5333
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5334 ending1 -= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5335 starting1 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5336 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5337
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5338 if (sequence2_listp && !ZEROP (start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5339 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5340 sequence2 = Fnthcdr (start2, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5341
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5342 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5344 check_sequence_range (args[1], start1, end1, Flength (args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5345 /* Nothing available to replace sequence1's contents. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5346 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5347 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5348
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5349 ending2 -= starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5350 starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5351 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5352
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5353 if (overwriting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5354 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5355 if (EQ (start1, start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5356 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5357 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5358 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5359
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5360 /* Our ranges may overlap. Save the data that might be overwritten. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5362 if (CONSP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5363 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5364 Elemcount len = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5365 Lisp_Object *subsequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5366 = alloca_array (Lisp_Object, min (ending2, len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5367 Elemcount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5369 LIST_LOOP_2 (elt, sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5370 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5371 if (counting == ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5372 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5373 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5374 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5376 subsequence[ii++] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5377 counting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5378 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5379
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5380 check_sequence_range (sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5381 /* The XFIXNUM (start2) is intentional here; we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5382 called #'length after doing (nthcdr
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5383 start2 sequence2). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5384 make_fixnum (XFIXNUM (start2) + len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5385 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5386 make_fixnum (XFIXNUM (start2) + len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5387
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5388 while (starting1 < ending1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5389 && starting2 < ending2 && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5390 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5391 XSETCAR (sequence1, subsequence[starting2]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5392 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5393 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5394 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5395 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5396 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5397 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5398 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5399 Ibyte *p = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5400 *pend = p + XSTRING_LENGTH (sequence2), *pcursor,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5401 *staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5402 Bytecount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5403
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5404 while (ii < starting2 && p < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5405 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5406 INC_IBYTEPTR (p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5407 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5408 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5409
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5410 pcursor = p;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5411
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5412 while (ii < ending2 && starting1 < ending1 && pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5413 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5414 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5415 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5416 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5417 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5418
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5419 if (pcursor == pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5420 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5421 check_sequence_range (sequence1, start1, end1, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5422 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5423 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5424 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5425 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5426 assert ((pcursor - p) > 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5427 staging = alloca_ibytes (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5428 memcpy (staging, p, pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5429 replace_string_range (result, start1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5430 make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5431 staging, staging + (pcursor - p));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5432 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5433 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5434 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5435 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5436 Elemcount seq_len = XFIXNUM (Flength (sequence2)), ii = 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5437 subseq_len = min (min (ending1 - starting1, seq_len - starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5438 min (ending2 - starting2, seq_len - starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5439 Lisp_Object *subsequence = alloca_array (Lisp_Object, subseq_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5441 check_sequence_range (sequence1, start1, end1, make_fixnum (seq_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5442 check_sequence_range (sequence2, start2, end2, make_fixnum (seq_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5443
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5444 while (starting2 < ending2 && ii < seq_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5445 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5446 subsequence[ii] = Faref (sequence2, make_fixnum (starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5447 ii++, starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5448 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5449
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5450 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5451
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5452 while (starting1 < ending1 && ii < seq_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5453 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5454 Faset (sequence1, make_fixnum (starting1), subsequence[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5455 ii++, starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5456 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5457 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5458 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5459 else if (sequence1_listp && sequence2_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5460 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5461 Lisp_Object sequence1_tortoise = sequence1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5462 sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5463 Elemcount shortest_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5465 counting = startcounting = min (ending1, ending2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5467 while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5468 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5469 XSETCAR (sequence1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5470 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5471 : Fcar (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5472 sequence1 = CONSP (sequence1) ? XCDR (sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5473 : Fcdr (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5474 sequence2 = CONSP (sequence2) ? XCDR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5475 : Fcdr (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5477 shortest_len++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5478
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5479 if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5480 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5481 if (counting & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5482 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5483 sequence1_tortoise = XCDR (sequence1_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5484 sequence2_tortoise = XCDR (sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5485 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5486
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5487 if (EQ (sequence1, sequence1_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5488 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5489 signal_circular_list_error (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5490 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5492 if (EQ (sequence2, sequence2_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5493 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5494 signal_circular_list_error (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5495 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5496 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5497 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5498
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5499 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5500 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5501 check_sequence_range (args[0], start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5502 make_fixnum (XFIXNUM (start1) + shortest_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5503 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5504 else if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5505 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5506 check_sequence_range (args[1], start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5507 make_fixnum (XFIXNUM (start2) + shortest_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5508 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5509 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5510 else if (sequence1_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5511 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5512 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5513 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5514 Ibyte *s2_data = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5515 *s2_end = s2_data + XSTRING_LENGTH (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5516 Elemcount char_count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5517 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5519 while (char_count < starting2 && s2_data < s2_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5521 INC_IBYTEPTR (s2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5522 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5523 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5524
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5525 while (starting1 < ending1 && starting2 < ending2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5526 && s2_data < s2_end && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5527 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5528 character = make_char (itext_ichar (s2_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5529 CONSP (sequence1) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5530 XSETCAR (sequence1, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5531 : Fsetcar (sequence1, character);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5532 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5533 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5534 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5535 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5536 INC_IBYTEPTR (s2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5537 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5538
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5539 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5540 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5541 check_sequence_range (sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5542 make_fixnum (XFIXNUM (start1) + starting1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5543 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5545 if (s2_data == s2_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5546 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5547 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5548 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5549 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5550 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5551 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5552 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5553 Elemcount len2 = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5554 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5555
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5556 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5557 while (starting2 < ending2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5558 && starting1 < ending1 && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5559 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5560 CHECK_CONS (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5561 XSETCAR (sequence1, Faref (sequence2, make_fixnum (starting2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5562 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5563 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5564 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5565 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5566
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5567 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5569 check_sequence_range (args[0], start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5570 make_fixnum (XFIXNUM (start1) + starting1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5571 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5572 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5573 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5574 else if (sequence2_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5575 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5576 if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5577 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5578 Elemcount ii = 0, count, len = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5579 Ibyte *staging, *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5580 Lisp_Object obj;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5582 check_sequence_range (sequence1, start1, end1, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5583 ending1 = min (ending1, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5584 count = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5585 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5586
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5587 while (ii < count && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5589 obj = CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5590 : Fcar (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5591
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5592 CHECK_CHAR_COERCE_INT (obj);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5593 cursor += set_itext_ichar (cursor, XCHAR (obj));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5594 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5595 sequence2 = XCDR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5596 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5597
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5598 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5599 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5600 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5601 make_fixnum (XFIXNUM (start2) + ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5604 replace_string_range (result, start1, make_fixnum (XFIXNUM (start1) + ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5605 staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5606 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5607 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5609 Elemcount len = XFIXNUM (Flength (sequence1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5610
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5611 check_sequence_range (sequence1, start2, end1, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5612 ending1 = min (ending2, min (ending1, len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5613
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5614 while (starting1 < ending1 && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5615 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5616 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5617 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5618 : Fcar (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5619 sequence2 = XCDR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5620 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5621 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5622 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5623
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5624 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5626 check_sequence_range (args[1], start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5627 make_fixnum (XFIXNUM (start2) + starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5628 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5629 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5630 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5631 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5633 if (STRINGP (sequence1) && STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5634 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5635 Ibyte *p2 = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5636 *p2end = p2 + XSTRING_LENGTH (sequence2), *p2cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5637 Charcount ii = 0, len1 = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5638
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5639 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5640
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5641 while (ii < starting2 && p2 < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5642 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5643 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5644 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5645 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5646
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5647 p2cursor = p2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5648 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5649
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5650 while (ii < ending2 && starting1 < ending1 && p2cursor < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5651 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5652 INC_IBYTEPTR (p2cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5653 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5654 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5655 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5656
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5657 if (p2cursor == p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5658 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5659 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5660 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5661
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5662 /* This isn't great; any error message won't necessarily reflect
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5663 the END1 that was supplied to #'replace. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5664 replace_string_range (result, start1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5665 p2, p2cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5667 else if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5669 Ibyte *staging, *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5670 Elemcount count, len1 = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5671 Elemcount len2 = XFIXNUM (Flength (sequence2)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5672 Lisp_Object obj;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5673
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5674 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5675 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5676
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5677 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5678 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5679 count = min (ending1 - starting1, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5680 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5682 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5683 while (ii < count)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5684 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5685 obj = Faref (sequence2, make_fixnum (starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5686
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5687 CHECK_CHAR_COERCE_INT (obj);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5688 cursor += set_itext_ichar (cursor, XCHAR (obj));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5689 starting2++, ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5690 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5692 replace_string_range (result, start1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5693 make_fixnum (XFIXNUM (start1) + count),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5694 staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5695 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5696 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5697 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5698 Ibyte *p2 = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5699 *p2end = p2 + XSTRING_LENGTH (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5700 Elemcount len1 = XFIXNUM (Flength (sequence1)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5701
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5702 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5703 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5704
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5705 while (ii < starting2 && p2 < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5706 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5707 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5708 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5709 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5711 while (p2 < p2end && starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5712 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5713 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5714 make_char (itext_ichar (p2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5715 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5716 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5717 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5718 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5719 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5721 if (p2 == p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5722 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5723 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5724 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5725 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5726 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5727 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5728 Elemcount len1 = XFIXNUM (Flength (sequence1)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5729 len2 = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5730
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5731 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5732 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5733
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5734 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5735 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5736
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5737 while (starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5739 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5740 Faref (sequence2, make_fixnum (starting2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5741 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5742 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5743 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5745 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5747 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5748 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5749
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5750 DEFUN ("nsubstitute", Fnsubstitute, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5751 Substitute NEW for OLD in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5752
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5753 This is a destructive function; it reuses the storage of SEQUENCE whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5754 possible. See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5755
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5756 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5757 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5758 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5759 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5760 Lisp_Object new_ = args[0], item = args[1], sequence = args[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5761 Lisp_Object object_, position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5762 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5763 Elemcount len, ii = 0, counting = MOST_POSITIVE_FIXNUM, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5764 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5765 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5767 PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5768 (test, if_, if_not, test_not, key, start, end, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5769 from_end), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5770
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5771 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5772 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5773 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5775 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5776 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5777 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5778 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5779 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5781 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5782 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5783 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5784 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5785 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5786 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5787 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5788 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5789 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5790 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5791 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5792 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5793 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5794 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5796 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5797 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5798 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5799 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5800 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5801
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5802 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5803 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5804
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5805 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5806 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5807 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5808 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5809 Lisp_Object present = count_with_tail (&object_, nargs - 1, args + 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5810 Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5812 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5813 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5814 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5815 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5817 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5818 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5819 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5820
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5821 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5822 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5823 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5824 if (!(ii < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5825 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5826 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5827 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5828
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5829 if (starting <= ii &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5830 check_test (test, key, item, elt) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5831 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5832 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5833 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5834 CHECK_LISP_WRITEABLE (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5835 XSETCAR (tail, new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5837 else if (!presenting && encountered >= counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5838 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5839 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5840 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5841
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5842 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5843 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5844 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5845 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5846
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5847 if ((ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5848 && encountered < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5849 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5850 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5851 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5852 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5853 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5854 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5855 Ibyte *staging, new_bytes[MAX_ICHAR_LEN], *staging_cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5856 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5857 Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5858 Bytecount new_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5859 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5860
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5861 CHECK_CHAR_COERCE_INT (new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5862
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5863 new_len = set_itext_ichar (new_bytes, XCHAR (new_));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5864
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5865 /* Worst case scenario; new char is four octets long, all the old ones
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5866 were one octet long, all the old ones match. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5867 staging = alloca_ibytes (XSTRING_LENGTH (sequence) * new_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5868 staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5869
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5870 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5871 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5872 Lisp_Object present = count_with_tail (&character, nargs - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5873 args + 1, Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5874
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5875 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5876 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5877 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5878 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5879
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5880 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5881
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5882 /* If there are fewer items in the string than we have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5883 permission to change, we don't need to differentiate
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5884 between the :from-end nil and :from-end t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5885 cases. Otherwise, presenting is the number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5886 items we need to ignore before we start to change. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5887 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5889
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5890 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5891 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5892 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5893 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5895 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5897 if ((check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5898 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5899 && (presenting ? encountered++ >= presenting :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5900 encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5901 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5902 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5903 += itext_copy_ichar (new_bytes, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5904 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5905 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5906 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5907 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5908 += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5909 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5910
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5911 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5912 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5913
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5914 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5915 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5917 mapping_interaction_error (Qnsubstitute, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5918 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5919 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5920 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5921 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5922 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5923 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5924
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5925 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5926 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5927 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5928 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5929
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5930 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5931 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5932 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5933 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5935 if (0 != encountered)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5936 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5937 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5938 replace_string_range (sequence, Qzero, make_fixnum (ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5939 staging, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5940 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5941 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5942 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5944 Elemcount positioning;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5945 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5947 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5948 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5949
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5950 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5951 test_not_unboundp, test, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5952 Qnil, Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5954 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5955 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5956 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5957 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5958
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5959 positioning = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5960 ending = min (len, ending);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5961
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5962 Faset (sequence, position0, new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5963 encountered = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5964
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5965 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5966 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5967 for (ii = positioning + 1; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5968 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5969 object_ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5970
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5971 if (check_test (test, key, item, object_) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5972 && encountered++ < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5973 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5974 Faset (sequence, make_fixnum (ii), new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5975 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5976 else if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5977 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5978 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5979 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5980 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5981 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5982 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5983 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5984 for (ii = positioning - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5985 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5986 object_ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5987
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5988 if (check_test (test, key, item, object_) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5989 && encountered++ < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5990 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5991 Faset (sequence, make_fixnum (ii), new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5992 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5993 else if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5994 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5995 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5996 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5997 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5998 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6000
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6001 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6002 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6003
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6004 DEFUN ("substitute", Fsubstitute, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6005 Substitute NEW for OLD in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6006
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6007 This is a non-destructive function; it makes a copy of SEQUENCE if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6008 to avoid corrupting the original SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6009
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6010 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6011
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6012 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) COUNT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6013 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6014 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6015 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6016 Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6017 Lisp_Object result = Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6018 Lisp_Object object, position0, matched_count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6019 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6020 Elemcount ii = 0, counting = MOST_POSITIVE_FIXNUM, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6021 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6022 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6023 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6025 PARSE_KEYWORDS (Fsubstitute, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6026 (test, if_, if_not, test_not, key, start, end, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6027 from_end), (start = Qzero, count = Qunbound));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6028
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6029 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6030
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6031 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6032 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6033
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6034 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6035 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6036 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6037 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6038 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6039
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6040 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6041 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6043 if (!UNBOUNDP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6045 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6046 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6047 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6048 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6049 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6050 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6051 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6052 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6053 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6054 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6055 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6056 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6057 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6058 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6059
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6060 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6061 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6062 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6063 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6064 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6065 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6066
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6067 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6068 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6069 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6070 test_not_unboundp, test, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6071 Qnil, Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6072
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6073 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6074 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6075 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6076 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6077 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6078 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6079 args[2] = Fcopy_sequence (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6080 return Fnsubstitute (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6081 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6082 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6083
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6084 matched_count = count_with_tail (&tail, nargs - 1, args + 1, Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6085
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6086 if (ZEROP (matched_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6087 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6088 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6089 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6090
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6091 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6092 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6093 presenting = XFIXNUM (matched_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6094 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6095 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6096
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6097 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6098 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6099 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6101 if (EQ (tail, tailing))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6102 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6103 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6104 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6105
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6106 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6107 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6108 return XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6109 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6110
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6111 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6112 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6113 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6114 else if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6115 (check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6116 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6117 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6119 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6120 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6121 result = result_tail = Fcons (new_, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6122 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6123 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6124 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6125 XSETCDR (result_tail, Fcons (new_, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6126 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6127 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6129 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6131 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6132 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6133 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6135 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6136 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6137 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6138
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6139 if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6140 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6141 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6142 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6143
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6144 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6146 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6148 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6149
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6150 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6151 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6152 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6153 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6154
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6155 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6156 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6157
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6158 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6159 subst (Lisp_Object new_, Lisp_Object old, Lisp_Object tree, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6161 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6162 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6163 stack_overflow ("Stack overflow in subst", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6164 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6165
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6166 if (EQ (tree, old))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6167 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6168 return new_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6169 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6170 else if (CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6172 Lisp_Object aa = subst (new_, old, XCAR (tree), depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6173 Lisp_Object dd = subst (new_, old, XCDR (tree), depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6174
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6175 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6176 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6177 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6178 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6179 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6180 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6181 return Fcons (aa, dd);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6182 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6183 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6184 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6185 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6186 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6187 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6188 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6189
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6190 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6191 sublis (Lisp_Object alist, Lisp_Object tree,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6192 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6193 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6194 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6195 Lisp_Object keyed = KEY (key, tree), aa, dd;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6196
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6197 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6198 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6199 stack_overflow ("Stack overflow in sublis", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6202 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6203 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6204 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6205 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6206 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6207 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6208 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6209 return XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6210 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6211 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6212 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6213 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6215 if (!CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6216 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6217 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6218 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6219
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6220 aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6221 depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6222 dd = sublis (alist, XCDR (tree), check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6223 depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6224
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6225 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6226 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6227 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6228 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6229
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6230 return Fcons (aa, dd);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6231 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6232
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6233 DEFUN ("sublis", Fsublis, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6234 Perform substitutions indicated by ALIST in TREE (non-destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6235 Return a copy of TREE with all matching elements replaced.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6236
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6237 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
6238
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6239 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
6240 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6241 (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
6242 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6243 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
6244 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
6245 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
6246
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6247 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
6248 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6249
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6250 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
6251 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6252 key = Qidentity;
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 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
6256 /* 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
6257 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
6258 us. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6259 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
6260
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6261 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
6262 && 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
6263 && (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
6264 (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
6265 !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
6266 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6267 /* #'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
6268 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
6269 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6270
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6271 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
6272 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6273
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6274 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
6275 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
6276 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
6277 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
6278 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
6279 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6280 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
6281 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
6282 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
6283
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6284 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
6285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6286 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
6287 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6288
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6289 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
6290
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6291 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
6292 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6293 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
6294 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
6295
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 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
6298 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6299 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
6300 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
6301 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6302 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
6303 /* 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
6304 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
6305 replaced = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6306 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6307 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6308 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6309 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
6310 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6311
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6312 if (!replaced)
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 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
6315 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6316 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
6317 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
6318 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6319 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6320
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6321 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
6322 replaced = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6324 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6325 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
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 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6328 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
6329 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6330 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
6331 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
6332 tree = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6333 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6334 }
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 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
6337 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6338
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6339 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
6340 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6341 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
6342 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6343
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6344 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
6345 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6346 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
6347 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6348 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
6349 }
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 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
6352 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6353 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
6354 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6355 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6356 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6357
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6358 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
6359 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6360
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6361 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
6362 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
6363 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
6364
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6365 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
6366
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6367 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
6368 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6369 (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
6370 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6371 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
6372 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
6373 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
6374 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
6375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6376 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
6377 (key = Qidentity));
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 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
6380 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6381 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6382 }
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 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
6385 /* 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
6386 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
6387 us. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6388 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
6389
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6390 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
6391
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6392 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
6393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6395 /* 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
6396 ourselves. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6397 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
6398 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6399 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
6400 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
6401 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6402 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6403 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
6404 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6405 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6406 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
6407 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6408
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6409 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6410
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6411 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
6412 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6413
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6414 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
6415 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
6416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6417 Return 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
6418
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6419 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
6420
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6421 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
6422 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6423 (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
6424 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6425 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
6426 Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6427 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
6428 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
6429 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
6430 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
6431
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6432 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6433 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6434
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6435 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
6436 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
6437
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6438 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
6439 `setcar').
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 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
6442 :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
6443 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
6444 undergo substitution.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6445
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6446 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
6447 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6448 (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
6449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6450 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
6451 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
6452 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
6453
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6454 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
6455 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
6456 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
6457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6458 check_test = 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
6459 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
6460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6461 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
6462 test, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6463
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6464 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6465
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6466 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
6467 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
6468 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
6469 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
6470 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
6471
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6472 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6473 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6474
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6475 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6476 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
6477 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
6478 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
6479 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6480 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
6481 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
6482 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
6483 Boolint result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6484
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6485 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
6486 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6487 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
6488 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6489
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6490 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
6491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6492 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
6493 && 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
6494 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
6495 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6496 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
6497 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
6498
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6499 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
6500 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6501 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
6502 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6503 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
6504 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
6505 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6506
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6507 if (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
6508 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6509 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
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 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
6513 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6514 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
6515 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6517 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6519 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
6520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6521 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6522 return 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6523 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6524
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6525 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
6526 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6527
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6528 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6529 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6530
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6531 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
6532 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
6533
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6534 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
6535 :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
6536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6537 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
6538
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6539 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
6540 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6541 (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
6542 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6543 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
6544 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
6545 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
6546
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6547 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
6548 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6549
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6550 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
6551 &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
6552
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6553 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
6554 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
6555 }
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 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
6558 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
6559 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
6560 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
6561 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
6562 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
6563 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6564 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
6565 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
6566 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
6567 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
6568 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
6569
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6570 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
6571 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
6572 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
6573 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
6574
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6575 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
6576 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
6577 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
6578 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
6579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6580 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
6581 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6582 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
6583 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
6584 = 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
6585
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 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
6588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6589 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
6590 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6591 *saving++ = elt;
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 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
6594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6595 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6596 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6597
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6598 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6599 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6600 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6601 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6602 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
6603 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6604 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
6605
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6606 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
6607 ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6608
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 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
6611 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6612 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
6613 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
6614 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
6615 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6616 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
6617 = 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
6618 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6619 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6620 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6621 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6622 sequence1_storage = 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
6623 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6624
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6625 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6627 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
6628 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6629 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
6630 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
6631 = 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
6632
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6633 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6634 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
6635 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6636 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
6637 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6638 *saving++ = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6640 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
6641 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6642 break;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6645 ++ii;
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 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6649 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
6650 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6651 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
6652
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6653 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
6654 ending2 - starting2);
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 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6657 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
6658 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6659 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
6660 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
6661 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
6662 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6663 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
6664 = 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
6665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6667 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6669 sequence2_storage = 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
6670 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6671
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6672 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
6673 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
6674 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
6675
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6676 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
6677 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6678 --ending1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6679 --ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6680
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6681 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
6682 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
6683 != 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
6684 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6685 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6686 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
6687 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6688 }
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 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6692 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
6693 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6694 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
6695 }
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 return Qnil;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6700 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
6701 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
6702 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
6703 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
6704 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
6705 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
6706 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6707 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
6708 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
6709 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
6710 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
6711 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
6712 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
6713
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6714 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
6715 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
6716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6717 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
6718 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6719 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
6720 }
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 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
6723 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6724 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
6725 }
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 (!ZEROP (start1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6728 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6729 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
6730
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6731 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
6732 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6733 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
6734 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
6735 /* 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
6736 return Qnil;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6739 ending1 -= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6740 starting1 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6741 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
6742 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6743
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6744 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
6745 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6746 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
6747
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6748 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
6749 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6750 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
6751 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
6752 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6753 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6754
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6755 ending2 -= starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6756 starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6757 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
6758 }
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 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
6761
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6762 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
6763
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6764 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
6765 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6766 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
6767 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
6768 : Fcar (sequence1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6769 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
6770 : 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
6771 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6772 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6773 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
6774 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6775
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6776 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
6777 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
6778
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6779 shortest_len++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6781 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
6782 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6783 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
6784 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6785 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
6786 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
6787 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6788
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6789 if (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
6790 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6791 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
6792 }
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 (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
6795 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6796 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
6797 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6798 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6799 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6800
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6801 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6802
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6803 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
6804 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6805 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
6806 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
6807 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
6808 }
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 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
6811 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6812 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
6813 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
6814 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
6815 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6817 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
6818 (!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
6819 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6820 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
6821 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6823 if ((NILP (end1) && 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
6824 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6825 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
6826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6827
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6828 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6829 }
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 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
6832 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
6833 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
6834 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
6835 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
6836 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
6837 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
6838 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
6839 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
6840 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6841 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
6842 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
6843 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
6844 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
6845 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
6846 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
6847
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6848 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
6849 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
6850
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6851 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
6852 string_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6853 = 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
6854
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6855 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
6856 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6857 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
6858 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
6859 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6860 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6861
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6862 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
6863 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6864 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
6865 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
6866 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6867 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
6868 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
6869 return Qnil;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6872 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
6873 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
6874 }
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 GCPRO1 (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6877
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6878 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
6879 && 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
6880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6881 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
6882
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6883 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
6884 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6885 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
6886 character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6887 != 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
6888 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6889 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6890 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
6891 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6892 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6893 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6895 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
6896 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
6897 != 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
6898 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6899 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6900 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
6901 }
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6904 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
6905
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6906 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
6907 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
6908 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
6909 || !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
6910 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6911 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
6912 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6913
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6914 list_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6915 string_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6916 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6917 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
6918 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
6919 }
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 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6922
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6923 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
6924 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6925 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
6926 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
6927 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
6928 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6929
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6930 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
6931 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6932 check_sequence_range (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
6933 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
6934 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6935
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6936 if ((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
6937 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
6938 (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
6939 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6940 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
6941 char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6942 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6944 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6945 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6947 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
6948 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
6949 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
6950 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
6951 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
6952 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
6953 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
6954 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
6955 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
6956 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6957 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
6958 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
6959 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
6960 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
6961
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6962 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
6963 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
6964
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6965 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
6966 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
6967 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
6968
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6969 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
6970
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6971 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
6972
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6973 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
6974 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6975 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
6976 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
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 (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
6979 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
6980 return Qnil;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6983 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
6984 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
6985 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6986
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6987 GCPRO1 (list);
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 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
6990 && !NILP (list))
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 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
6993 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6994 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
6995 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
6996 != 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
6997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6998 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6999 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
7000 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7001 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7002 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7003 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7004 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
7005 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
7006 != 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
7007 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7008 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7009 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
7010 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7013 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
7014 list_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7015 array_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7016 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7017 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7018
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7019 UNGCPRO;
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 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
7022 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7023 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
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 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
7026 }
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 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
7029 (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
7030 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7031 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
7032 array_starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7033 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7034
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7035 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7036 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7037
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7038 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
7039 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
7040 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
7041 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
7042 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
7043 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
7044 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
7045 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
7046 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7047 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
7048 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
7049 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
7050 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
7051 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
7052
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7053 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
7054 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
7055 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
7056 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
7057 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
7058
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7059 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
7060 string_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7061 = 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
7062
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7063 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
7064 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7065 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
7066 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
7067 char_count++;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7070 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
7071 && 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
7072 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7073 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
7074
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7075 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
7076 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7077 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
7078 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
7079 != 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
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 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
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 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7085 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7086 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
7087 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
7088 character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7089 != 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 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7091 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
7092 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7093 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7094
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7095 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
7096 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
7097 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
7098 || !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
7099 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7100 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
7101 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7102
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7103 array_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7104 string_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7105 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7106 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
7107 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
7108 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7109
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7110 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
7111 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7112 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
7113 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
7114 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7116 if ((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
7117 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
7118 (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
7119 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7120 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
7121 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
7122 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7123
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7124 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7125 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7126
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7127 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
7128 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
7129 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
7130 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
7131 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
7132 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
7133 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
7134 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
7135 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
7136 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7137 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
7138 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
7139 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
7140 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
7141 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
7142 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
7143 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
7144
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7145 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
7146 string1_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7147 = 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
7148
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7149 string2_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7150 = 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
7151 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
7152
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7153 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
7154 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7155 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
7156 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
7157 char_count1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7158 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7159
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7160 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
7161 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7162 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
7163 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
7164 char_count2++;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7167 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
7168 && 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
7169 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7170 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
7171 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
7172
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7173 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
7174 != 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
7175 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7176 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
7177 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7178
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7179 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
7180 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
7181 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
7182 || !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
7183 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7184 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
7185 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7186
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7187 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
7188 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
7189 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
7190 || !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
7191 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7192 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
7193 }
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 string1_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7197 char_count1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7198 char_count2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7199 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
7200 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
7201 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
7202 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
7203 }
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 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
7206 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7207 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
7208 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
7209 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7210
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7211 if (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
7212 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7213 check_sequence_range (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
7214 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
7215 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7216
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7217 if ((!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
7218 (!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
7219 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7220 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
7221 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7222
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7223 if ((NILP (string1_end) && string1_data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7224 < (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
7225 (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
7226 < (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
7227 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7228 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
7229 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7230
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7231 return Qnil;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7234 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
7235 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
7236 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
7237 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
7238 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
7239 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
7240 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7241 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
7242 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
7243 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
7244
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7245 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
7246 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
7247
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7248 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
7249 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
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 (!NILP (end1))
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 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
7254 }
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 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
7257 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7258 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
7259 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7260
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7261 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
7262 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
7263
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7264 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
7265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7266 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
7267 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
7268 != 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
7269 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7270 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
7271 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7272 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7273 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7274 }
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 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
7277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7278 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
7279 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7280
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7281 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7282 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7283
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7284 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
7285 (*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
7286 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
7287 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
7288 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
7289 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
7290
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7291 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
7292 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
7293 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
7294 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7295 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
7296 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
7297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7298 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
7299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7300 *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
7301 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
7302 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7303
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7304 if (LISTP (sequence1))
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 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
7307 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7308 *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
7309 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
7310 }
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 (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7313 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7314 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7315 return mismatch_list_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7316 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7317
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7318 *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
7319 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
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 (STRINGP (sequence1))
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 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
7325 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7326 *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
7327 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
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 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
7331 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7332 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7333 return mismatch_list_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7334 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7335
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7336 *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
7337 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
7338 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7339
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7340 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
7341 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7342 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
7343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7344 *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
7345 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
7346 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7347
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7348 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7349 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7350 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7351 return mismatch_list_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7352 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7353
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7354 *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_array_array;
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 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
7359 return NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7360 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7362 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
7363 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
7364
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7365 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
7366 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
7367 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
7368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7369 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
7370
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7371 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
7372 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7373 (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
7374 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7375 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
7376 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
7377 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
7378 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
7379
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7380 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
7381 (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
7382 (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
7383
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7384 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
7385 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
7386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7387 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
7388 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
7389
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7390 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
7391 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7392 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
7393 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7394
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7395 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
7396 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7397 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
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 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
7401 &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
7402 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
7403 &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
7404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7405 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
7406 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7407 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
7408 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
7409 }
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 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
7412 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
7413 }
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 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
7416 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
7417
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7418 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
7419 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
7420
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7421 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
7422 :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
7423 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
7424
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7425 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
7426 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7427 (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
7428 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7429 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
7430 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
7431 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
7432 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
7433 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
7434 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
7435 Elemcount length1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7436 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
7437 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
7438
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7439 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
7440 (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
7441 (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
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_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7444 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
7445 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
7446
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7447 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
7448 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
7449 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
7450 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
7451
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7452 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
7453 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7454 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
7455
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7456 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
7457 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
7458 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
7459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7460 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7461 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7462 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
7463 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
7464 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
7465 }
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 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
7468
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7469 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
7470 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7471 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
7472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7473 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
7474 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
7475 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
7476 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7477 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7478 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7479 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
7480 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
7481 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
7482 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7484 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
7485 &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
7486 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
7487
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7488 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
7489 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7490 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
7491 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7492 return start2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7493 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7494
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7495 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
7496 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7497 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
7498 }
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 return end2;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7503 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
7504 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7505 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
7506 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
7507 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
7508
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7509 ii = starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7510 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
7511 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7512 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
7513 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
7514 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
7515 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
7516 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7517 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7518 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7519 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7520
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7521 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
7522 (return_first ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7523 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
7524 sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7525 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
7526 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
7527 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
7528 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
7529 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
7530 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
7531 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
7532 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
7533
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7534
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 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7537 return position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7538 }
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 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
7541 }
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 UNGCPRO;
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 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7546 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7547 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
7548 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
7549 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
7550
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7551 ii = ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7552 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
7553 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7554 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
7555 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
7556 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
7557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7558 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
7559 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7560 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7561 return Qnil;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7564 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
7565 (return_first ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7566 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
7567 sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7568 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
7569 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
7570 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
7571 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
7572 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
7573 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
7574 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
7575 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
7576 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7577 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7578 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
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 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
7582 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7583
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7584 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7585 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7586
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7587 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7588 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7589
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7590 /* 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
7591 Venn diagrams. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7592 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
7593 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
7594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7595 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
7596 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
7597 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
7598 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
7599 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
7600 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
7601
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7602 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
7603 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
7604
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7605 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
7606 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
7607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7608 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
7609
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7610 /* #### 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
7611 tests. */
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7612 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
7613 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7614 if (NILP (liszt1))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7615 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7616 return Qt;
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7617 }
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7618 if (NILP (liszt2))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7619 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7620 return Qnil;
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7621 }
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7622 }
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7623
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7624 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
7625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7626 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7627 }
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 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
7630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7631 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
7632 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7633
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7634 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
7635 &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
7636
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7637 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
7638
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7639 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7640 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
7641 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7642 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
7643 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
7644 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
7645 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
7646 != intersectionp)
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 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
7649 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7650 result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7651 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7652 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7653 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
7654 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7655 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
7656 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7657 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
7658 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7659 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
7660 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7661 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7662 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7663 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
7664 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
7665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7667 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7668 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
7669 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7670
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7671 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7672
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7673 return result;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7676 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
7677 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
7678 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7679 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
7680 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
7681 Elemcount count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7682 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
7683 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
7684 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
7685
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7686 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
7687 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
7688
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7689 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
7690 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
7691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7692 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
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 (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
7695 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7696 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7697 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7698
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7699 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
7700 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7701 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
7702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7703
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7704 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
7705 &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
7706
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7707 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
7708
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7709 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
7710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7711 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
7712 (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
7713 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7714 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
7715 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
7716 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
7717 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
7718 == intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7719 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7720 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
7721 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7722 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
7723 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7724 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7725 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7726 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
7727 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7728
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7729 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
7730 /* 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
7731 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7732 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7733 else
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 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
7736 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
7737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7738
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7739 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
7740
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7741 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
7742 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7743 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
7744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7746 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
7747 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7748 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
7749 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7750 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7751
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7752 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7754 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7755 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7756
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7757 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
7758 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
7759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7760 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
7761 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
7762 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
7763
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7764 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
7765 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
7766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7767 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
7768
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7769 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
7770 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7771 (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
7772 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7773 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
7774 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7775
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7776 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
7777 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
7778
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7779 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
7780 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
7781 possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7782
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7783 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
7784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7785 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
7786 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7787 (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
7788 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7789 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
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 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
7793 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
7794
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7795 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
7796
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7797 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
7798 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7799 (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
7800 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7801 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
7802 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7803
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7804 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
7805 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
7806
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7807 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
7808 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
7809 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
7810
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7811 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
7812
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7813 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
7814 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
7815
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7816 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
7817 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7818 (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
7819 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7820 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
7821 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7823 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
7824 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
7825
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7826 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
7827 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
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 (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
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 ("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
7839 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
7840 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
7841
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7842 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
7843 possible.
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 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
7846
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7847 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
7848 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7849 (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
7850 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7851 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
7852 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
7853 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7854
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7855 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
7856 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
7857 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
7858 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
7859 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
7860
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7861 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
7862 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
7863 information.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7864
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7865 :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
7866 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
7867 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
7868 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
7869 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
7870 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
7871
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7872 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
7873 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
7874 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
7875
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7876 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
7877 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7878 (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
7879 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7880 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
7881 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
7882 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
7883 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
7884 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
7885
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7886 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
7887
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7888 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
7889 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
7890
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7891 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
7892
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7893 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
7894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7895 return liszt2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7896 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7897
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7898 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
7899 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7900 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7901 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7902
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7903 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
7904 &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
7905
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7906 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
7907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7908 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
7909 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7910 result = liszt2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7911 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7912 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
7913 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7914 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
7915 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
7916 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
7917 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
7918 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7919 /* 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
7920 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
7921 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
7922 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
7923 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
7924 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
7925 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
7926 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
7927 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
7928 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7929 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7930 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
7931 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7932 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7933 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7934 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7935 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
7936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7937 /* 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
7938 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
7939 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
7940 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
7941 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
7942 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
7943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7944 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
7945 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7946 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
7947 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
7948 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
7949 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7950 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
7951 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7952 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
7953 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7954 else
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 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
7957 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
7958 }
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 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7961 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
7962 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7963
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7964 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
7965 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7966
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7967 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7968
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7969 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7970 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7972 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
7973 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
7974
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7975 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
7976 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
7977 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
7978
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7979 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
7980
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7981 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
7982 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
7983 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
7984
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7985 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
7986 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7987 (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
7988 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7989 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
7990 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
7991 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
7992 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
7993 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
7994
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7995 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
7996 (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
7997
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7998 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
7999 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
8000
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8001 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
8002
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8003 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
8004 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8005 return liszt1;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8008 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
8009 &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
8010
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8011 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
8012 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8013 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
8014 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8015 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
8016 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
8017 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
8018 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
8019 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8020 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
8021 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8022 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
8023 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8024 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
8025 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8026 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
8027 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8028 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8029 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8030 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
8031 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
8032 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8033 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8034 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8035 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
8036 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8037
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8038 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8039 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
8040 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8041 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
8042 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
8043 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
8044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8045 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
8046 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8047 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
8048 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8049 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
8050 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8051 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
8052 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8053 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8054 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8055 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
8056 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
8057 }
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 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8060 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
8061 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8062
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8063 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8064
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8065 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8066 }
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 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
8069 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
8070
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8071 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
8072 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
8073 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
8074
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8075 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
8076
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8077 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
8078 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8079 (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
8080 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8081 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
8082 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
8083 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
8084 Elemcount count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8085 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
8086 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
8087 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
8088
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8089 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
8090 (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
8091
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8092 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
8093 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
8094
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8095 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
8096
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8097 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
8098 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8099 return liszt1;
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8102 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
8103 &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
8104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8105 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
8106
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8107 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
8108
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8109 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
8110 (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
8111 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8112 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
8113 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
8114 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
8115 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
8116 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8117 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
8118
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8119 if (NILP (prev_tail))
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 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
8122 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8123 else
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 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
8126 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8127
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8128 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
8129 result = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8130 tail = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8131
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8132 /* 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
8133 count = 0;
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 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8136 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8137 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
8138 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
8139 }
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 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
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 (count & 1)
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 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
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 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
8149 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8150 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
8151 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8153
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8154 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
8155
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8156 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
8157 (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
8158 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8159 /* 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
8160 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
8161 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
8162 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
8163 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8164 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
8165 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
8166 result = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8167 tail = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8168 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8169 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8170 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8172 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
8173 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8174
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8175 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
8176
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8177 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
8178 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8179 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
8180 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8181
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8182 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
8183 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8184 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
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
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8188 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8189
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8190 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8191 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8192
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8193 void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8194 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
8195 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8196 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
8197 DEFSYMBOL (Qmerge);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8198 DEFSYMBOL (Qfill);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8199 DEFSYMBOL (Qidentity);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8200 DEFSYMBOL (Qvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8201 DEFSYMBOL (Qarray);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8202 DEFSYMBOL (Qstring);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8203 DEFSYMBOL (Qlist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8204 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
8205 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
8206 DEFSYMBOL (Qreduce);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8207 DEFSYMBOL (Qreplace);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8208 DEFSYMBOL (Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8209 DEFSYMBOL (Qfind);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8210 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
8211 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
8212
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8213 DEFSYMBOL (Qmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8214 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
8215 DEFSYMBOL (Qmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8216 DEFSYMBOL (Qmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8217 DEFSYMBOL (Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8218 DEFSYMBOL (Qmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8219 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
8220 DEFSYMBOL (Qsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8221 DEFSYMBOL (Qevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8222 DEFSYMBOL (Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8223 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
8224 DEFSYMBOL (Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8225 DEFSYMBOL (Qmismatch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8226 DEFSYMBOL (Qintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8227 DEFSYMBOL (Qnintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8228 DEFSYMBOL (Qsubsetp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8229 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
8230 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
8231 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
8232 DEFSYMBOL (Qnunion);
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 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
8235 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
8236 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
8237 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
8238 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
8239 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
8240 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
8241 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
8242 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
8243 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
8244 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
8245 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
8246
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8247 DEFSUBR (Flength);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8248 DEFSUBR (Fcount);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8249 DEFSUBR (Fsubseq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8250 DEFSUBR (Felt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8251 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
8252 DEFSUBR (Fmember);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8253 DEFSUBR (Fmemq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8254 DEFSUBR (FmemberX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8255 DEFSUBR (Fadjoin);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8256 DEFSUBR (Fassoc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8257 DEFSUBR (Fassq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8258 DEFSUBR (FassocX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8259 DEFSUBR (Frassoc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8260 DEFSUBR (Frassq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8261 DEFSUBR (FrassocX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8262 DEFSUBR (Fposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8263 DEFSUBR (Ffind);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8264 DEFSUBR (FdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8265 DEFSUBR (FremoveX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8266 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
8267 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
8268 DEFSUBR (Fnreverse);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8269 DEFSUBR (Freverse);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8270 DEFSUBR (Fmerge);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8271 DEFSUBR (FsortX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8272 DEFSUBR (Ffill);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8273 DEFSUBR (Fmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8274 DEFSUBR (FmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8275 DEFSUBR (Fmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8276 DEFSUBR (Fmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8277 DEFSUBR (Fmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8278 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
8279 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
8280 DEFSUBR (Fmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8281 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
8282 DEFSUBR (Fsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8283 DEFSUBR (Fevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8284 DEFSUBR (Freduce);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8285 DEFSUBR (Freplace);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8286 DEFSUBR (Fnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8287 DEFSUBR (Fsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8288 DEFSUBR (Fsublis);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8289 DEFSUBR (Fnsublis);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8290 DEFSUBR (Fsubst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8291 DEFSUBR (Fnsubst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8292 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
8293 DEFSUBR (Fmismatch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8294 DEFSUBR (Fsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8295 DEFSUBR (Fintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8296 DEFSUBR (Fnintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8297 DEFSUBR (Fsubsetp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8298 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
8299 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
8300 DEFSUBR (Fnunion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8301 DEFSUBR (Funion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8302 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
8303 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
8304 }