xemacs-beta: src/sequence.c annotate

annotate src/sequence.c @ 5887:6eca500211f4

Prototype for X509_check_host() has changed, detect this in configure.ac ChangeLog addition: 2015-04-09 Aidan Kehoe <kehoea@parhasard.net> * configure.ac: If X509_check_host() is available, check the number of arguments it takes. Don't use it if it takes any number of arguments other than five. Also don't use it if <openssl/x509v3.h> does not declare it, since if that is so there is no portable way to tell how many arguments it should take, and so we would end up smashing the stack. * configure: Regenerate. src/ChangeLog addition: 2015-04-09 Aidan Kehoe <kehoea@parhasard.net> * tls.c: #include <openssl/x509v3.h> for its prototype for X509_check_host(). * tls.c (tls_open): Pass the new fifth argument to X509_check_host().

author	Aidan Kehoe <kehoea@parhasard.net>
date	Thu, 09 Apr 2015 14:27:02 +0100
parents	e9bb3688e654
children	a0e751d6c3ad

rev	line source
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1 /* Various functions that operate on sequences, split out from fns.c
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2 Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2010 Ben Wing.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5 This file is part of XEmacs.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7 XEmacs is free software: you can redistribute it and/or modify it
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8 under the terms of the GNU General Public License as published by the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	9 Free Software Foundation, either version 3 of the License, or (at your
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	10 option) any later version.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	11
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	15 for more details.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	16
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	17 You should have received a copy of the GNU General Public License
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	19
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	20 #include <config.h>
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	21 #include "lisp.h"
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	22 #include "extents.h"
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	23
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	24 Lisp_Object Qadjoin, Qarray, QassocX, Qbit_vector, Qcar_less_than_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	25 Lisp_Object QdeleteX, Qdelete_duplicates, Qevery, Qfill, Qfind, Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	26 Lisp_Object Qintersection, Qmap, Qmap_into, Qmapc, Qmapcan, QmapcarX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	27 Lisp_Object Qmapconcat, Qmapvector, Qmerge, Qmismatch, Qnintersection;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	28 Lisp_Object Qnset_difference, Qnsubstitute, Qnunion, Qposition, QrassocX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	29 Lisp_Object Qreduce, QremoveX, Qreplace, Qset_difference, Qsome, QsortX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	30 Lisp_Object Qstring_lessp, Qsubsetp, Qsubstitute, Qvector;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	31
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	32 Lisp_Object Q_count, Q_descend_structures, Q_end1, Q_end2, Q_from_end;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	33 Lisp_Object Q_if_, Q_if_not, Q_initial_value, Q_stable, Q_start1, Q_start2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	34 Lisp_Object Q_test_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	35
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	36 extern Fixnum max_lisp_eval_depth;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	37 extern int lisp_eval_depth;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	38
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	39 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	40
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	41 static DOESNT_RETURN
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	42 mapping_interaction_error (Lisp_Object func, Lisp_Object object)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	43 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	44 invalid_state_2 ("object modified while traversing it", func, object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	45 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	46
5772 cd4f5f1f1f4c Add #'write-sequence, on the model of #'write-char, API from Common Lisp. Aidan Kehoe <kehoea@parhasard.net> parents: 5752 diff changeset	47 void
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	48 check_sequence_range (Lisp_Object sequence, Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	49 Lisp_Object end, Lisp_Object length)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	50 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	51 Lisp_Object args[] = { Qzero, start, NILP (end) ? length : end, length };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	52
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	53 if (NILP (Fleq (countof (args), args)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	54 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	55 args_out_of_range_3 (sequence, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	56 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	57 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	58
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	59 DEFUN ("length", Flength, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	60 Return the length of vector, bit vector, list or string SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	61 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	62 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	63 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	64 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	65 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	66 return make_fixnum (string_char_length (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	67 else if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	68 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	69 Elemcount len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	70 GET_EXTERNAL_LIST_LENGTH (sequence, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	71 return make_fixnum (len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	72 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	73 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	74 return make_fixnum (XVECTOR_LENGTH (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	75 else if (NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	76 return Qzero;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	77 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	78 return make_fixnum (bit_vector_length (XBIT_VECTOR (sequence)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	79 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	80 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	81 check_losing_bytecode ("length", sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	82 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	83 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	84 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	85 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	86
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	87 /* Various test functions for #'member, #'assoc and the other functions
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	88 that take both TEST and KEY arguments. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	89
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	90 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	91 check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	92 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	93 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	94 return EQ (item, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	95 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	96
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	97 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	98 check_eq_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	99 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	101 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	102 return EQ (item, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	105 /* The next two are not used by #'member* and #'assoc*, since we can decide
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	106 on #'eq vs. #'equal when we have the type of ITEM. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	107 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	108 check_eql_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	109 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	111 return EQ (elt1, elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	112 \|\| (NON_FIXNUM_NUMBER_P (elt1) && internal_equal (elt1, elt2, 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	113 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	114
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	115 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	116 check_eql_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	117 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	119 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	120 return EQ (item, elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	121 \|\| (NON_FIXNUM_NUMBER_P (item) && internal_equal (item, elt, 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	122 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	123
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	124 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	125 check_equal_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	126 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	127 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	128 return internal_equal (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	129 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	130
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	131 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	132 check_equal_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	133 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	135 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	136 return internal_equal (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	137 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	138
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	139 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	140 check_equalp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	141 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	142 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	143 return internal_equalp (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	144 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	145
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	146 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	147 check_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	148 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	149 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	150 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	151 return internal_equalp (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	153
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	154 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	155 check_string_match_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	156 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	158 return !NILP (Fstring_match (item, elt, Qnil, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	159 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	160
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	161 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	162 check_string_match_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	163 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	164 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	165 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	166 return !NILP (Fstring_match (item, elt, Qnil, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	168
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	169 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	170 check_other_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	171 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	172 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	173 Lisp_Object args[] = { test, item, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	174 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	175
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	176 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	177 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	178 item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	179 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	181 return !NILP (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	182 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	183
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	184 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	185 check_other_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	186 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	187 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	188 Lisp_Object args[] = { item, key, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	189 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	190
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	191 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	192 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	193 args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args) - 1, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	194 args[1] = item;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	195 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	196 item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	197 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	199 return !NILP (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	202 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	203 check_if_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	204 Lisp_Object UNUSED (item), Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	205 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	206 elt = IGNORE_MULTIPLE_VALUES (call1 (test, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	207 return !NILP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	208 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	209
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	210 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	211 check_if_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	212 Lisp_Object UNUSED (item), Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	213 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	214 Lisp_Object args[] = { key, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	215 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	216
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	217 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	218 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	219 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	220 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	221 elt = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	222 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	223
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	224 return !NILP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	225 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	227 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	228 check_match_eq_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	229 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	230 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	231 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	232 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	234 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	235 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	236 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	237 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	238 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	239 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	240
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	241 return EQ (args[0], args[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	242 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	243
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	244 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	245 check_match_eql_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	246 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	248 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	249 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	250
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	251 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	252 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	253 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	254 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	255 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	256 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	257
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	258 return EQ (args[0], args[1]) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	259 (NON_FIXNUM_NUMBER_P (args[0]) && internal_equal (args[0], args[1], 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	262 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	263 check_match_equal_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	264 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	266 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	267 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	269 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	270 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	271 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	272 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	273 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	274 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	276 return internal_equal (args[0], args[1], 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	277 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	278
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	279 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	280 check_match_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	281 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	283 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	284 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	285
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	286 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	287 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	288 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	289 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	290 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	291 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	293 return internal_equalp (args[0], args[1], 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	294 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	295
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	296 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	297 check_match_other_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	298 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	300 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	301 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	302
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	303 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	304 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	305 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	306 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	307 args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	308 args[1] = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	309 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	310
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	311 elt1 = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	312 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	314 return !NILP (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	316
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	317 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	318 check_lss_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	319 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	320 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	321 return bytecode_arithcompare (elt1, elt2) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	324 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	325 check_lss_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	326 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	327 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	328 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	329 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	331 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	332 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	333 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	334 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	335 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	336 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	337
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	338 return bytecode_arithcompare (args[0], args[1]) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	339 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	340
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	341 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	342 check_lss_key_car (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	343 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	344 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	345 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	346
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	347 GCPRO2 (elt1, elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	348 elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	349 elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	350 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	351
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	352 return bytecode_arithcompare (elt1, elt2) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	353 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	354
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	355 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	356 check_string_lessp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	357 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	359 return !NILP (Fstring_lessp (elt1, elt2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	360 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	362 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	363 check_string_lessp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	364 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	365 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	366 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	367 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	369 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	370 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	371 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	372 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	373 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	374 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	376 return !NILP (Fstring_lessp (args[0], args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	377 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	378
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	379 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	380 check_string_lessp_key_car (Lisp_Object UNUSED (test),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	381 Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	382 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	384 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	386 GCPRO2 (elt1, elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	387 elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	388 elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	389 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	391 return !NILP (Fstring_lessp (elt1, elt2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	394 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	395 get_check_match_function_1 (Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	396 Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	397 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	398 Lisp_Object key, Boolint *test_not_unboundp_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	399 check_test_func_t *test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	401 Lisp_Object test = *test_inout;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	402 check_test_func_t result = NULL, test_func = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	403 Boolint force_if = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	405 if (!NILP (if_))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	406 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	407 if (!(NILP (test) && NILP (test_not) && NILP (if_not)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	408 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	409 invalid_argument ("only one keyword among :test :test-not "
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	410 ":if :if-not allowed", if_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	411 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	412
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	413 test = *test_inout = if_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	414 force_if = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	416 else if (!NILP (if_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	417 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	418 if (!(NILP (test) && NILP (test_not)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	419 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	420 invalid_argument ("only one keyword among :test :test-not "
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	421 ":if :if-not allowed", if_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	422 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	423
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	424 test_not = if_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	425 force_if = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	426 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	427
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	428 if (NILP (test))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	429 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	430 if (!NILP (test_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	431 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	432 test = *test_inout = test_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	433 if (NULL != test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	435 *test_not_unboundp_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	436 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	437 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	438 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	439 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	440 test = Qeql;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	441 if (NULL != test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	443 *test_not_unboundp_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	444 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	445 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	446 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	447 else if (!NILP (test_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	448 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	449 invalid_argument_2 ("conflicting :test and :test-not keyword arguments",
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	450 test, test_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	452
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	453 test = indirect_function (test, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	455 if (NILP (key) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	456 EQ (indirect_function (key, 1), XSYMBOL_FUNCTION (Qidentity)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	458 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	461 if (force_if)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	462 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	463 result = EQ (key, Qidentity) ? check_if_nokey : check_if_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	465 if (NULL != test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	466 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	467 *test_func_out = result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	468 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	470 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	473 if (!UNBOUNDP (item) && EQ (test, XSYMBOL_FUNCTION (Qeql)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	474 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	475 test = XSYMBOL_FUNCTION (NON_FIXNUM_NUMBER_P (item) ? Qequal : Qeq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	476 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	477
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	478 #define FROB(known_test, eq_condition) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	479 if (EQ (test, XSYMBOL_FUNCTION (Q##known_test))) do \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	480 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	481 if (eq_condition) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	482 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	483 test = XSYMBOL_FUNCTION (Qeq); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	484 goto force_eq_check; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	485 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	486 \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	487 if (!EQ (Qidentity, key)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	488 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	489 test_func = check_##known_test##_key; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	490 result = check_match_##known_test##_key; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	491 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	492 else \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	493 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	494 result = test_func = check_##known_test##_nokey; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	495 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	496 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	498 FROB (eql, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	499 else if (SUBRP (test))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	500 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	501 force_eq_check:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	502 FROB (eq, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	503 else FROB (equal, (SYMBOLP (item) \|\| FIXNUMP (item) \|\| CHARP (item)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	504 else FROB (equalp, (SYMBOLP (item)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	505 else if (EQ (test, XSYMBOL_FUNCTION (Qstring_match)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	506 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	507 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	508 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	509 test_func = result = check_string_match_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	511 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	512 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	513 test_func = check_string_match_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	514 result = check_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	515 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	517 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	519 if (NULL == result)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	521 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	522 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	523 test_func = result = check_other_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	524 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	525 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	526 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	527 test_func = check_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	528 result = check_match_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	529 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	530 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	532 if (NULL != test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	533 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	534 *test_func_out = test_func;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	535 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	537 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	538 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	539 #undef FROB
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	541 /* Given TEST, TEST_NOT, IF, IF_NOT, KEY, and ITEM, return a C function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	542 pointer appropriate for use in deciding whether a given element of a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	543 sequence satisfies TEST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	545 Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	546 if it was bound, and set *test_inout to the value it was bound to. If
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	547 TEST was not bound, leave *test_inout alone; the value is not used by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	548 check_eq_key() or check_equal_key(), which are the defaults, depending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	549 on the type of ITEM.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	550
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	551 The returned function takes arguments (TEST, KEY, ITEM, ELT), where ITEM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	552 is the item being searched for and ELT is the element of the sequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	553 being examined.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	554
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	555 Error if both TEST and TEST_NOT were specified, which Common Lisp says is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	556 undefined behaviour. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	558 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	559 get_check_test_function (Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	560 Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	561 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	562 Lisp_Object key, Boolint *test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	563 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	564 check_test_func_t result = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	565 get_check_match_function_1 (item, test_inout, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	566 key, test_not_unboundp_out, &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	567 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	568 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	569
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	570 /* Given TEST, TEST_NOT, IF, IF_NOT and KEY, return a C function pointer
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	571 appropriate for use in deciding whether two given elements of a sequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	572 satisfy TEST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	574 Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	575 if it was bound, and set *test_inout to the value it was bound to. If
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	576 TEST was not bound, leave *test_inout alone; the value is not used by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	577 check_eql_*key().
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	578
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	579 The returned function takes arguments (TEST, KEY, ELT1, ELT2), where ELT1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	580 and ELT2 are elements of the sequence being examined.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	582 The value that would be given by get_check_test_function() is returned in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	583 *TEST_FUNC_OUT, which allows calling functions to do their own key checks
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	584 if they're processing one element at a time.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	585
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	586 Error if both TEST and TEST_NOT were specified, which Common Lisp says is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	587 undefined behaviour. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	589 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	590 get_check_match_function (Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	591 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	592 Lisp_Object key, Boolint *test_not_unboundp_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	593 check_test_func_t *test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	595 return get_check_match_function_1 (Qunbound, test_inout, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	596 if_, if_not, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	597 test_not_unboundp_out, test_func_out);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	599
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	600 /* Given PREDICATE and KEY, return a C function pointer appropriate for use
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	601 in deciding whether one given element of a sequence is less than
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	602 another. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	604 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	605 get_merge_predicate (Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	606 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	607 predicate = indirect_function (predicate, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	608
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	609 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	610 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	611 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	612 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	613 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	614 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	615 key = indirect_function (key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	616 if (EQ (key, XSYMBOL_FUNCTION (Qidentity)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	617 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	618 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	619 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	620 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	621
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	622 if (EQ (key, Qidentity) && EQ (predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	623 XSYMBOL_FUNCTION (Qcar_less_than_car)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	624 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	625 key = XSYMBOL_FUNCTION (Qcar);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	626 predicate = XSYMBOL_FUNCTION (Qlss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	627 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	628
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	629 if (EQ (predicate, XSYMBOL_FUNCTION (Qlss)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	631 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	633 return check_lss_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	634 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	635
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	636 if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	637 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	638 return check_lss_key_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	640
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	641 return check_lss_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	643
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	644 if (EQ (predicate, XSYMBOL_FUNCTION (Qstring_lessp)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	645 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	646 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	647 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	648 return check_string_lessp_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	649 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	651 if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	653 return check_string_lessp_key_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	655
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	656 return check_string_lessp_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	657 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	658
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	659 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	661 return check_other_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	664 return check_match_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	666
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	667
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	668 static Lisp_Object string_count_from_end (Lisp_Object, Lisp_Object ,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	669 check_test_func_t, Boolint,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	670 Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	671 Lisp_Object, Lisp_Object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	672
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	673 static Lisp_Object list_count_from_end (Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	674 check_test_func_t, Boolint,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	675 Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	676 Lisp_Object, Lisp_Object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	677
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	678 /* Count the number of occurrences of ITEM in SEQUENCE; if SEQUENCE is a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	679 list, store the cons cell of which the car is the last ITEM in SEQUENCE,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	680 at the address given by tail_out. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	682 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	683 count_with_tail (Lisp_Object tail_out, int nargs, Lisp_Object args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	684 Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	686 Lisp_Object item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	687 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	688 Elemcount len, ii = 0, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	689 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	690 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	692 PARSE_KEYWORDS_8 (caller, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	693 (test, key, start, end, from_end, test_not, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	694 if_, if_not), (start = Qzero), 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	696 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	697 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	698 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	700 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	701 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	702 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	703 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	706 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	707 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	708 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	709 counting = BIGNUMP (count) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	711 /* Our callers should have filtered out non-positive COUNT. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	712 assert (counting >= 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	713 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	714
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	715 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	716 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	718 *tail_out = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	719
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	720 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	721 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	722 if (EQ (caller, Qcount) && !NILP (from_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	723 && (!EQ (key, Qnil) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	724 check_test == check_other_nokey \|\| check_test == check_if_nokey))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	725 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	726 /* #'count, #'count-if, and #'count-if-not are documented to have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	727 a given traversal order if :from-end t is passed in, even
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	728 though forward traversal of the sequence has the same result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	729 and is algorithmically less expensive for lists and strings.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	730 This order isn't necessary for other callers, though. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	731 return list_count_from_end (item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	732 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	733 start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	734 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	735
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	736 /* If COUNT is non-nil and FROM-END is t, we can give the tail
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	737 containing the last match, since that's what #'remove* is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	738 interested in (a zero or negative COUNT won't ever reach
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	739 count_with_tail(), our callers will return immediately on seeing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	740 it). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	741 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	742 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	743 counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	746 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	747 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	748 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	749 if (!(ii < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	750 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	751 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	752 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	754 if (starting <= ii &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	755 check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	756 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	757 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	758 *tail_out = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	760 if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	761 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	762 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	763 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	764 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	765
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	766 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	767 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	768 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	769 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	770
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	771 if ((ii < starting \|\| (ii < ending && !NILP (end))) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	772 encountered != counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	773 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	774 check_sequence_range (args[1], start, end, Flength (args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	775 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	776 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	777 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	778 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	779 Ibyte startp = XSTRING_DATA (sequence), cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	780 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	781 Lisp_Object character = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	782
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	783 if (EQ (caller, Qcount) && !NILP (from_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	784 && (!EQ (key, Qnil) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	785 check_test == check_other_nokey \|\| check_test == check_if_nokey))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	786 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	787 /* See comment above in the list code. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	788 return string_count_from_end (item, sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	789 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	790 test, key, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	791 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	792
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	793 while (cursor_offset < byte_len && ii < ending && encountered < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	794 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	795 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	796 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	797 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	798
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	799 if (check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	800 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	801 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	802 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	804
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	805 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	806 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	807 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	808 \|\| !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	809 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	810 mapping_interaction_error (caller, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	811 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	812 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	813
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	814 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	815 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	816 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	817 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	819 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	820 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	821 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	822 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	823 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	824 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	825 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	826 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	827
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	828 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	829 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	831 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	832 if (0 == len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	833 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	834 /* Catches the case where we have nil. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	835 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	837
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	838 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	839 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	840 for (ii = starting; ii < ending && encountered < counting; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	841 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	842 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	843 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	845 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	847 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	848 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	849 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	850 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	851 for (ii = ending - 1; ii >= starting && encountered < counting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	852 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	853 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	854 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	855 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	856 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	857 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	858 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	859 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	860 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	861
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	862 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	863 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	864
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	865 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	866 list_count_from_end (Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	867 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	868 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	869 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	870 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	871 Elemcount length = XFIXNUM (Flength (sequence)), ii = 0, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	872 Elemcount ending = NILP (end) ? length : XFIXNUM (end), encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	873 Lisp_Object *storage;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	874 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	875
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	876 check_sequence_range (sequence, start, end, make_integer (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	877
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	878 storage = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	879
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	881 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	882 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	883 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	884 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	885 storage[ii - starting] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	886 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	887 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	889 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	890
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	891 GCPRO1 (storage[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	892 gcpro1.nvars = ending - starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	893
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	894 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	895 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	896 if (check_test (test, key, item, storage[ii - starting])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	897 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	898 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	899 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	900 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	901 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	902
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	903 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	905 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	906 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	908 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	909 string_count_from_end (Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	910 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	911 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	912 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	913 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	914 Elemcount length = string_char_length (sequence), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	915 Elemcount starting = XFIXNUM (start), ending = NILP (end) ? length : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	916 Elemcount encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	917 Ibyte *cursor = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	918 Ibyte *endp = cursor + XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	919 Ichar *storage;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	920
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	921 check_sequence_range (sequence, start, end, make_integer (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	922
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	923 storage = alloca_array (Ichar, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	924
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	925 while (cursor < endp && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	926 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	927 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	928 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	929 storage [ii - starting] = itext_ichar (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	930 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	931
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	932 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	933 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	934 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	935
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	936 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	937 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	938 if (check_test (test, key, item, make_char (storage [ii - starting]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	939 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	941 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	942 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	943 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	944
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	945 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	946 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	947
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	948 DEFUN ("count", Fcount, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	949 Count the number of occurrences of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	951 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	952
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	953 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	954 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	955 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	956 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	957 Lisp_Object tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	958
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	959 /* count_with_tail() accepts more keywords than we do, check those we've
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	960 been given. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	961 PARSE_KEYWORDS (Fcount, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	962 (test, test_not, if_, if_not, key, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	963 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	964
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	965 return count_with_tail (&tail, nargs, args, Qcount);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	966 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	968 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	969 Return the subsequence of SEQUENCE starting at START and ending before END.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	970 END may be omitted; then the subsequence runs to the end of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	972 If START or END is negative, it counts from the end, in contravention of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	973 Common Lisp.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	974 The returned subsequence is always of the same type as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	975 If SEQUENCE is a string, relevant parts of the string-extent-data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	976 are copied to the new string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	977
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	978 See also `substring-no-properties', which only operates on strings, and does
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	979 not copy extent data.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	980 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	981 (sequence, start, end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	982 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	983 Elemcount len, ss, ee = MOST_POSITIVE_FIXNUM, ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	984 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	985
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	986 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	987 CHECK_FIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	988 ss = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	989
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	990 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	991 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	992 CHECK_FIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	993 ee = XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	994 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	995
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	996 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	998 Bytecount bstart, blen;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	999
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1000 get_string_range_char (sequence, start, end, &ss, &ee,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1001 GB_HISTORICAL_STRING_BEHAVIOR);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1002 bstart = string_index_char_to_byte (sequence, ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1003 blen = string_offset_char_to_byte_len (sequence, bstart, ee - ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1004
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1005 result = make_string (XSTRING_DATA (sequence) + bstart, blen);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1006 /* Copy any applicable extent information into the new string. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1007 copy_string_extents (result, sequence, 0, bstart, blen);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1008 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1009 else if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1010 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1011 Lisp_Object result_tail, saved = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1013 if (ss < 0 \|\| ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1014 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1015 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1016 if (ss < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1017 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1018 ss = len + ss;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1019 start = make_integer (ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1020 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1021
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1022 if (ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1023 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1024 ee = len + ee;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1025 end = make_integer (ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1026 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1027 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1028 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1029 ee = min (ee, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1030 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1031 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1032
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1033 if (0 != ss)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1034 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1035 sequence = Fnthcdr (make_fixnum (ss), sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1036 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1037
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1038 ii = ss + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1039
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1040 if (ss < ee && !NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1041 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1042 result = result_tail = Fcons (Fcar (sequence), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1043 sequence = Fcdr (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1044
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1045 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1046 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1047 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1048 if (!(ii < ee))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1049 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1050 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1051 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1052
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1053 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1054 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1055 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1056 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1057 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1058 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1059
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1060 if (NILP (result) \|\| (ii < ee && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1061 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1062 /* We were handed a cons, which definitely has elements. nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1063 result means either ss >= ee or SEQUENCE was nil after the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1064 nthcdr; in both cases that means START and END were incorrectly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1065 specified for this sequence. ii < ee with a non-nil end means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1066 the user handed us a bogus end value. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1067 check_sequence_range (saved, start, end, Flength (saved));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1068 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1070 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1071 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1072 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1073 if (ss < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1074 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1075 ss = len + ss;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1076 start = make_integer (ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1077 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1078
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1079 if (ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1080 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1081 ee = len + ee;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1082 end = make_integer (ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1083 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1084 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1085 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1086 ee = min (len, ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1087 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1088
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1089 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1090
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1091 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1092 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1093 result = Fvector (ee - ss, XVECTOR_DATA (sequence) + ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1094 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1095 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1096 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1097 result = make_bit_vector (ee - ss, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1098
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1099 for (ii = ss; ii < ee; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1101 set_bit_vector_bit (XBIT_VECTOR (result), ii - ss,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1102 bit_vector_bit (XBIT_VECTOR (sequence), ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1104 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1105 else if (NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1106 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1107 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1108 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1109 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1111 /* Won't happen, since CHECK_SEQUENCE didn't error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1112 ABORT ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1113 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1114 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1116 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1117 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1118
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1119 DEFUN ("elt", Felt, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1120 Return element of SEQUENCE at index N.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1121 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1122 (sequence, n))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1123 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1124 /* This function can GC */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1125 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1126 CHECK_FIXNUM_COERCE_CHAR (n); /* yuck! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1127 if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1128 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1129 Lisp_Object tem = Fnthcdr (n, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1130 /* #### Utterly, completely, fucking disgusting.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1131 * #### The whole point of "elt" is that it operates on
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1132 * #### sequences, and does error- (bounds-) checking.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1133 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1134 if (CONSP (tem))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1135 return XCAR (tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1136 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1137 #if 1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1138 /* This is The Way It Has Always Been. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1139 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1140 #else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1141 /* This is The Way Mly and Cltl2 say It Should Be. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1142 args_out_of_range (sequence, n);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1143 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1144 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1145 else if (STRINGP (sequence) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1146 VECTORP (sequence) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1147 BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1148 return Faref (sequence, n);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1149 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1150 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1151 check_losing_bytecode ("elt", sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1152 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1153 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1155 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1156
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1157 DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1158 Return a copy of a list and substructures.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1159 The argument is copied, and any lists contained within it are copied
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1160 recursively. Circularities and shared substructures are not preserved.
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	1161 Second arg VECTORP causes vectors to be copied, too. Strings and bit
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	1162 vectors are not copied.
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1163 */
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	1164 (arg, vectorp))
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	1165 {
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	1166 return safe_copy_tree (arg, vectorp, 0);
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1168
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1169 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1170 safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1172 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1173 stack_overflow ("Stack overflow in copy-tree", arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1174
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1175 if (CONSP (arg))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1176 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1177 Lisp_Object rest;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1178 rest = arg = Fcopy_sequence (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1179 while (CONSP (rest))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1180 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1181 Lisp_Object elt = XCAR (rest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1182 QUIT;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1183 if (CONSP (elt) \|\| VECTORP (elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1184 XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1185 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1186 XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1187 rest = XCDR (rest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1188 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1189 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1190 else if (VECTORP (arg) && ! NILP (vecp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1191 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1192 int i = XVECTOR_LENGTH (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1193 int j;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1194 arg = Fcopy_sequence (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1195 for (j = 0; j < i; j++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1196 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1197 Lisp_Object elt = XVECTOR_DATA (arg) [j];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1198 QUIT;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1199 if (CONSP (elt) \|\| VECTORP (elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1200 XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1201 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1202 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1203 return arg;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1204 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1206 DEFUN ("member", Fmember, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1207 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1208 The value is actually the tail of LIST whose car is ELT.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1209 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1210 (elt, list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1211 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1212 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1213 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1214 if (internal_equal (elt, list_elt, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1215 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1216 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1217 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1218 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1219
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1220 DEFUN ("memq", Fmemq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1221 Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1222 The value is actually the tail of LIST whose car is ELT.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1223 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1224 (elt, list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1225 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1226 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1227 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1228 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1229 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1230 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1231 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1232 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1234 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1235 memq_no_quit (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1236 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1237 LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1238 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1239 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1240 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1241 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1242 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1243 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1244
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1245 /* Return the first index of ITEM in LIST. In CONS_OUT, return the cons cell
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1246 before that containing the element. If the element is in the first cons
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1247 cell, return Qnil in CONS_OUT. TEST, KEY, START, END are as in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1248 #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should have been initialized
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1249 with get_check_match_function() or get_check_test_function(). A non-zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1250 REVERSE_TEST_ORDER means call TEST with the element from LIST as its
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1251 first argument and ITEM as its second. Error if LIST is ill-formed, or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1252 circular. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1253 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1254 list_position_cons_before (Lisp_Object *cons_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1255 Lisp_Object item, Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1256 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1257 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1258 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1259 Boolint reverse_test_order,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1260 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1261 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1262 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1263 Lisp_Object tail_before = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1264 Elemcount ii = 0, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1265 Elemcount ending = NILP (end) ? MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1266
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1267 GCPRO1 (tail_before);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1269 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1270 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1271 /* TEST is #'eq, no need to call any C functions, and the test order
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1272 won't be visible. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1273 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1274 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1275 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1276 EQ (item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1278 *cons_out = tail_before;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1279 RETURN_UNGCPRO (make_integer (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1280 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1281 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1283 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1284 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1285 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1286 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1287 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1288 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1289 tail_before = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1290 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1291 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1292 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1293 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1294 GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1295 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1296 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1297 (reverse_test_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1298 check_test (test, key, elt, item) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1299 check_test (test, key, item, elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1300 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1301 *cons_out = tail_before;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1302 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1303 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1304 return make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1305 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1306 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1307 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1308 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1309 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1310 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1311 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1312 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1313 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1314 tail_before = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1316 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1317 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1318
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1319 RETURN_UNGCPRO (Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1320 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1321
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1322 DEFUN ("member", FmemberX, 2, MANY, 0, /
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1323 Return the first sublist of LIST with car ITEM, or nil if no such sublist.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1324
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1325 The keyword :test specifies a two-argument function that is used to compare
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1326 ITEM with elements in LIST; if omitted, it defaults to `eql'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1327
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1328 The keyword :test-not is similar, but specifies a negated function. That
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1329 is, ITEM is considered equal to an element in LIST if the given function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1330 returns nil. Common Lisp deprecates :test-not, and if both are specified,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1331 XEmacs signals an error.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1332
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1333 :key specifies a one-argument function that transforms elements of LIST into
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1334 \"comparison keys\" before the test predicate is applied. For example,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1335 if :key is #'car, then ITEM is compared with the car of elements from LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1336 The :key function, however, is not applied to ITEM, and does not affect the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1337 elements in the returned list, which are taken directly from the elements in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1338 LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1339
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1340 arguments: (ITEM LIST &key (TEST #'eql) TEST-NOT (KEY #'identity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1341 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1342 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1344 Lisp_Object item = args[0], list = args[1], result = Qnil, position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1345 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1346 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1347
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1348 PARSE_KEYWORDS (FmemberX, nargs, args, 5, (test, if_not, if_, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1349 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1350 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1351 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1352 position0
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1353 = list_position_cons_before (&result, item, list, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1354 test_not_unboundp, test, key, 0, Qzero, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1355
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1356 return CONSP (result) ? XCDR (result) : ZEROP (position0) ? list : Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1357 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1358
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1359 /* This macro might eventually find a better home than here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1360
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1361 #define CHECK_KEY_ARGUMENT(key) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1362 do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1363 if (NILP (key)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1364 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1365 key = Qidentity; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1366 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1367 \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1368 if (!EQ (key, Qidentity)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1369 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1370 key = indirect_function (key, 1); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1371 if (EQ (key, XSYMBOL_FUNCTION (Qidentity))) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1372 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1373 key = Qidentity; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1374 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1375 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1376 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1377
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1378 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1379 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1380
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1381 DEFUN ("adjoin", Fadjoin, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1382 Return ITEM consed onto the front of LIST, if not already in LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1383
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1384 Otherwise, return LIST unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1386 See `member*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1387
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1388 arguments: (ITEM LIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1389 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1390 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1391 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1392 Lisp_Object item = args[0], list = args[1], keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1393 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1394 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1395 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1396
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1397 PARSE_KEYWORDS (Fadjoin, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1398 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1399
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1400 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1401
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1402 keyed = KEY (key, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1403
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1404 GCPRO1 (keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1405 check_test = get_check_test_function (keyed, &test, test_not, Qnil, Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1406 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1407 if (NILP (list_position_cons_before (&ignore, keyed, list, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1408 test_not_unboundp, test, key, 0, Qzero,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1409 Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1410 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1411 RETURN_UNGCPRO (Fcons (item, list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1412 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1413
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1414 RETURN_UNGCPRO (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1417 DEFUN ("assoc", Fassoc, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1418 Return non-nil if KEY is `equal' to the car of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1419 The value is actually the element of ALIST whose car equals KEY.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1420 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1421 (key, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1422 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1423 /* This function can GC. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1424 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1425 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1426 if (internal_equal (key, elt_car, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1427 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1428 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1429 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1430 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1431
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1432 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1433 assoc_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1435 int speccount = specpdl_depth ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1436 specbind (Qinhibit_quit, Qt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1437 return unbind_to_1 (speccount, Fassoc (key, alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1438 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1439
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1440 DEFUN ("assq", Fassq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1441 Return non-nil if KEY is `eq' to the car of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1442 The value is actually the element of ALIST whose car is KEY.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1443 Elements of ALIST that are not conses are ignored.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1444 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1445 (key, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1446 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1447 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1448 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1449 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1450 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1452 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1453 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1455 /* Like Fassq but never report an error and do not allow quits.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1456 Use only on lists known never to be circular. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1458 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1459 assq_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1460 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1461 /* This cannot GC. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1462 LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1463 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1464 Lisp_Object elt_car = XCAR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1465 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1466 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1467 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1468 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1469 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1470
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1471 DEFUN ("assoc", FassocX, 2, MANY, 0, /
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1472 Find the first item whose car matches ITEM in ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1473
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1474 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1475
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1476 arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1477 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1478 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1479 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1480 Lisp_Object item = args[0], alist = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1481 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1482 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1484 PARSE_KEYWORDS (FassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1485 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1486
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1487 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1488 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1489
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1490 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1491 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1492 /* TEST is #'eq, no need to call any C functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1493 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1494 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1495 if (EQ (item, elt_car) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1496 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1497 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1498 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1500 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1501 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1502 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1503 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1504 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1505 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1506 check_test (test, key, item, XCAR (elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1507 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1508 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1509 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1511 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1512 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1513 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1514
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1515 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1518 DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1519 Return non-nil if VALUE is `equal' to the cdr of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1520 The value is actually the element of ALIST whose cdr equals VALUE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1521 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1522 (value, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1523 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1524 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1525 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1526 if (internal_equal (value, elt_cdr, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1527 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1528 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1529 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1530 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1532 DEFUN ("rassq", Frassq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1533 Return non-nil if VALUE is `eq' to the cdr of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1534 The value is actually the element of ALIST whose cdr is VALUE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1535 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1536 (value, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1537 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1538 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1539 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1540 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1541 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1542 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1543 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1544 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1546 /* Like Frassq, but caller must ensure that ALIST is properly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1547 nil-terminated and ebola-free. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1548 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1549 rassq_no_quit (Lisp_Object value, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1550 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1551 LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1552 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1553 Lisp_Object elt_cdr = XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1554 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1555 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1556 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1557 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1558 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1559
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1560 DEFUN ("rassoc", FrassocX, 2, MANY, 0, /
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1561 Find the first item whose cdr matches ITEM in ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1562
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1563 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1565 arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1566 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1567 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1569 Lisp_Object item = args[0], alist = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1570 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1571 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1572
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1573 PARSE_KEYWORDS (FrassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1574 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1575
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1576 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1577 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1578
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1579 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1580 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1581 /* TEST is #'eq, no need to call any C functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1582 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1583 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1584 if (EQ (item, elt_cdr) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1585 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1586 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1587 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1588 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1589 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1590 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1591 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1592 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1593 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1594 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1595 check_test (test, key, item, XCDR (elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1596 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1597 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1598 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1599 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1600 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1601 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1604 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1605 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1606
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1607 /* This is the implementation of both #'find and #'position. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1608 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1609 position (Lisp_Object *object_out, Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1610 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1611 Lisp_Object test, Lisp_Object key, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1612 Lisp_Object from_end, Lisp_Object default_, Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1613 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1614 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1615 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, len, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1616
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1617 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1618 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1619 starting = FIXNUMP (start) ? XFIXNUM (start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1620
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1621 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1622 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1623 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1624 ending = FIXNUMP (end) ? XFIXNUM (end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1627 *object_out = default_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1628
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1629 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1631 if (!(starting < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1633 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1634 /* starting could be equal to ending, in which case nil is what
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1635 we want to return. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1636 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1637 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1638
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1639 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1640 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1641 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1642 if (starting <= ii && ii < ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1643 && check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1644 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1645 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1646 *object_out = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1647
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1648 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1649 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1650 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1651 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1652 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1653 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1654 else if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1655 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1656 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1657 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1658
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1659 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1660 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1661 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1664 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1666 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1667 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1668 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1669 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1670 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1671 Ibyte startp = XSTRING_DATA (sequence), cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1672 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1673 Lisp_Object character = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1674
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1675 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1676 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1677 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1678 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1679 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1680
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1681 if (check_test (test, key, item, character) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1682 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1683 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1684 *object_out = character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1685
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1686 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1687 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1688 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1689 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1690 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1692 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1693 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1694 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1695 \|\| !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1696 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1697 mapping_interaction_error (caller, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1698 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1699 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1700
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1701 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1702 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1703 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1706 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1707 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1708 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1709 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1710 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1711 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1712 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1713 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1714 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1715 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1717 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1718 if (0 == len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1719 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1720 /* Catches the case where we have nil. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1721 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1722 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1724 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1725 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1726 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1727 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1728 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1729 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1730 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1731 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1732 *object_out = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1733 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1734 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1735 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1736 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1737 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1739 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1740 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1741 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1742 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1743 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1744 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1745 *object_out = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1746 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1747 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1748 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1749 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1750 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1751
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1752 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1753 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1754
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1755 DEFUN ("position", Fposition, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1756 Return the index of the first occurrence of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1757
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1758 Return nil if not found. See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1760 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1761 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1762 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1763 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1764 Lisp_Object object = Qnil, item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1765 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1766 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1767
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1768 PARSE_KEYWORDS (Fposition, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1769 (test, if_, test_not, if_not, key, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1770 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1771
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1772 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1773 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1775 return position (&object, item, sequence, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1776 test, key, start, end, from_end, Qnil, Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1777 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1778
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1779 DEFUN ("find", Ffind, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1780 Find the first occurrence of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1781
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1782 Return the matching ITEM, or nil if not found. See `remove*' for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1783 meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1785 The keyword :default, not specified by Common Lisp, designates an object to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1786 return instead of nil if ITEM is not found.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1787
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1788 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) DEFAULT FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1789 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1790 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1791 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1792 Lisp_Object object = Qnil, item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1793 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1794 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1796 PARSE_KEYWORDS (Ffind, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1797 (test, if_, test_not, if_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1798 default_),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1799 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1800
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1801 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1802 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1803
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1804 position (&object, item, sequence, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1805 test, key, start, end, from_end, default_, Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1806
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1807 return object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1808 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1810 /* Like #'delq, but caller must ensure that LIST is properly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1811 nil-terminated and ebola-free. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1812
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1813 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1814 delq_no_quit (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1815 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1816 LIST_LOOP_DELETE_IF (list_elt, list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1817 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1818 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1819 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1820
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1821 /* Be VERY careful with this. This is like delq_no_quit() but
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1822 also calls free_cons() on the removed conses. You must be SURE
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1823 that no pointers to the freed conses remain around (e.g.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1824 someone else is pointing to part of the list). This function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1825 is useful on internal lists that are used frequently and where
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1826 the actual list doesn't escape beyond known code bounds. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1827
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1828 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1829 delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1831 REGISTER Lisp_Object tail = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1832 REGISTER Lisp_Object prev = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1834 while (!NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1835 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1836 REGISTER Lisp_Object tem = XCAR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1837 if (EQ (elt, tem))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1838 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1839 Lisp_Object cons_to_free = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1840 if (NILP (prev))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1841 list = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1842 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1843 XCDR (prev) = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1844 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1845 free_cons (cons_to_free);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1847 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1848 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1849 prev = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1850 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1851 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1852 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1853 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1854 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1856 DEFUN ("delete", FdeleteX, 2, MANY, 0, /
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1857 Remove all occurrences of ITEM in SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1859 If SEQUENCE is a non-nil list, this modifies the list directly. A non-list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1860 SEQUENCE will not be destructively modified, rather, if ITEM occurs in it, a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1861 new SEQUENCE of the same type without ITEM will be returned.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1862
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1863 See `remove*' for a non-destructive alternative, and for explanation of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1864 keyword arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1865
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1866 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1867 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1868 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1869 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1870 Lisp_Object item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1871 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1872 Elemcount len, ii = 0, encountered = 0, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1873 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1874 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1875
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1876 PARSE_KEYWORDS (FdeleteX, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1877 (test, if_not, if_, test_not, key, start, end, from_end,
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1878 count), (start = Qzero));
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1879
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1880 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1881 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1882 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1883
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1884 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1885 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1886 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1887 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1889
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1890 if (!NILP (count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1891 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1892 CHECK_INTEGER (count);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1893 if (FIXNUMP (count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1894 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1895 counting = XFIXNUM (count);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1896 }
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1897 #ifdef HAVE_BIGNUM
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1898 else
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1899 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1900 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1901 1 + MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM - 1;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1902 }
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1903 #endif
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1904 if (counting < 1)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1905 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1906 return sequence;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1907 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1908
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1909 if (!NILP (from_end))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1910 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1911 /* Sigh, this is inelegant. Force count_with_tail () to ignore
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1912 the count keyword, so we get the actual number of matching
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1913 elements, and can start removing from the beginning for the
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1914 from-end case. */
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1915 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FdeleteX))->min_args;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1916 ii < nargs; ii += 2)
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1917 {
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1918 if (EQ (args[ii], Q_count))
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1919 {
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1920 args[ii + 1] = Qnil;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1921 break;
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1922 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1923 }
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	1924 ii = 0;
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1925 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1926 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1927
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1928 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1929 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1930
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1931 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1932 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1933 Lisp_Object prev_tail_list_elt = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1934 Elemcount list_len = 0, deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1935 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1937 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1938 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1939 /* Both COUNT and FROM-END were specified; we need to traverse the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1940 list twice. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1941 Lisp_Object present = count_with_tail (&ignore, nargs, args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1942 QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1944 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1945 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1946 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1948
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1949 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1951 /* If there are fewer items in the list than we have permission to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1952 delete, we don't need to differentiate between the :from-end
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1953 nil and :from-end t cases. Otherwise, presenting is the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1954 of matching items we need to ignore before we start to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1955 delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1956 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1957 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1958
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1959 GCPRO1 (prev_tail_list_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1960 ii = -1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1961
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1963 GC_EXTERNAL_LIST_LOOP_4 (list_elt, sequence, tail, list_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1964 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1965 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1966
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1967 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1968 (check_test (test, key, item, list_elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1969 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1970 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1971 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1972 if (NILP (prev_tail_list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1973 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1974 sequence = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1975 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1976 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1977 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1978 XSETCDR (prev_tail_list_elt, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1979 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1980
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1981 /* Keep tortoise from ever passing hare. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1982 list_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1983 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1984 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1985 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1986 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1987 prev_tail_list_elt = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1988 if (ii >= ending \|\| (!presenting && encountered > counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1989 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1990 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1992 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1993 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1994 END_GC_EXTERNAL_LIST_LOOP (list_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1995 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1996
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1997 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1998
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	1999 if ((ii < starting \|\| (ii < ending && !NILP (end))) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2000 !(presenting ? encountered == presenting : encountered == counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2001 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2002 check_sequence_range (args[1], start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2003 make_fixnum (deleted + XFIXNUM (Flength (args[1]))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2005
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2006 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2007 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2008 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2009 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2010 Ibyte *staging = alloca_ibytes (XSTRING_LENGTH (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2011 Ibyte staging_cursor = staging, startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2012 Ibyte *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2013 Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2014 Lisp_Object character, result = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2016 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2017 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2018 Lisp_Object present = count_with_tail (&character, nargs, args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2019 QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2020
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2021 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2022 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2023 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2024 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2025
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2026 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2027
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2028 /* If there are fewer items in the list than we have permission to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2029 delete, we don't need to differentiate between the :from-end
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2030 nil and :from-end t cases. Otherwise, presenting is the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2031 of matching items we need to ignore before we start to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2032 delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2033 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2034 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2036 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2037 while (cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2038 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2039 if (ii >= starting && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2040 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2041 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2043 if ((check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2044 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2045 && (presenting ? encountered++ >= presenting :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2046 encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2047 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2048 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2049 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2050 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2051 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2052 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2053 += set_itext_ichar (staging_cursor, XCHAR (character));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2054 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2055
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2056 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2057 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2058 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2059 \|\| !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2060 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2061 mapping_interaction_error (QdeleteX, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2062 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2063 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2064 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2065 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2066 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2067 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2068
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2069 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2070 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2071 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2072 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2073
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2074 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2075 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2076 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2077 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2078
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2079 if (0 != encountered)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2080 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2081 result = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2082 copy_string_extents (result, sequence, 0, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2083 staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2084 sequence = result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2085 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2086
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2087 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2088 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2089 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2090 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2091 Lisp_Object position0 = Qnil, object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2092 Lisp_Object staging = NULL, staging_cursor, *staging_limit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2093 Elemcount positioning;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2094
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2095 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2096
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2097 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2098
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2099 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2100 test_not_unboundp, test, key, start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2101 from_end, Qnil, QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2102 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2103 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2104 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2105 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2106
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2107 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2108 positioning = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2109 encountered = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2110
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2111 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2112 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2113 staging = alloca_array (Lisp_Object, len - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2114 staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2116 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2117 while (ii < positioning)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2119 *staging_cursor++ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2120 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2121 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2122
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2123 ii = positioning + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2124 while (ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2126 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2127 if (encountered < counting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2128 && (check_test (test, key, item, object)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2129 == test_not_unboundp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2131 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2132 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2133 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2135 *staging_cursor++ = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2136 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2137 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2138 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2139
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2140 while (ii < len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2141 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2142 *staging_cursor++ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2143 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2144 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2146 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2147 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2148 staging = alloca_array (Lisp_Object, len - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2149 staging_cursor = staging_limit = staging + len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2150
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2151 ii = len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2152 while (ii > positioning)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2153 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2154 *--staging_cursor = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2155 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2156 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2157
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2158 ii = positioning - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2159 while (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2161 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2162 if (encountered < counting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2163 && (check_test (test, key, item, object) ==
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2164 test_not_unboundp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2165 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2166 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2168 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2169 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2170 *--staging_cursor = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2171 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2172
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2173 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2174 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2175
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2176 while (ii >= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2177 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2178 *--staging_cursor = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2179 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2180 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2181
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2182 staging = staging_cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2183 staging_cursor = staging_limit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2184 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2185
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2186 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2187 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2188 return Fvector (staging_cursor - staging, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2189 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2190 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2191 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2192 return Fbit_vector (staging_cursor - staging, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2193 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2194
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2195 /* A nil sequence will have given us a nil #'position,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2196 above. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2197 ABORT ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2199 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2201 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2202
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2203 DEFUN ("remove", FremoveX, 2, MANY, 0, /
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2204 Remove all occurrences of ITEM in SEQUENCE, non-destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2206 If SEQUENCE is a list, `remove*' makes a copy if that is necessary to avoid
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2207 corrupting the original SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2208
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2209 The keywords :test and :test-not specify two-argument test and negated-test
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2210 predicates, respectively; :test defaults to `eql'. :key specifies a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2211 one-argument function that transforms elements of SEQUENCE into \"comparison
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2212 keys\" before the test predicate is applied. See `member*' for more
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2213 information on these keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2215 :start and :end, if given, specify indices of a subsequence of SEQUENCE to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2216 be processed. Indices are 0-based and processing involves the subsequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2217 starting at the index given by :start and ending just before the index given
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2218 by :end.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2219
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2220 :count, if given, limits the number of items removed to the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2221 specified. :from-end, if given, causes processing to proceed starting from
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2222 the end instead of the beginning; in this case, this matters only if :count
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2223 is given.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2224
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2225 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2226 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2227 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2228 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2229 Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2230 tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2231 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2232 Elemcount ii = 0, encountered = 0, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2233 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2234 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2235
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2236 PARSE_KEYWORDS (FremoveX, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2237 (test, if_not, if_, test_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2238 count), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2239
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2240 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2241 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2242 return FdeleteX (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2243 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2244
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2245 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2246 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2247
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2248 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2249 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2250 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2251 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2252 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2253
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2254 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2255 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2256 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2257 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2258 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2259 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2261 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2262 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2263 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2264 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2265 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2266 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2267 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2269 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2270 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2271 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2272 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2273
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2274 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2275 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2276 /* Sigh, this is inelegant. Force count_with_tail () to ignore the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2277 count keyword, so we get the actual number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2278 elements, and can start removing from the beginning for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2279 from-end case. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2280 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FremoveX))->min_args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2281 ii < nargs; ii += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2283 if (EQ (args[ii], Q_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2284 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2285 args[ii + 1] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2286 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2287 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2288 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2289 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2290 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2291 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2293 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2294 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2295
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2296 matched_count = count_with_tail (&tail, nargs, args, QremoveX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2298 if (!ZEROP (matched_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2300 Lisp_Object result = Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2301 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2302
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2303 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2304 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2305 presenting = XFIXNUM (matched_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2306
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2307 /* If there are fewer matching elements in the list than we have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2308 permission to delete, we don't need to differentiate between
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2309 the :from-end nil and :from-end t cases. Otherwise, presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2310 is the number of matching items we need to ignore before we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2311 start to delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2312 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2313 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2314
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2315 GCPRO2 (result, tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2316 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2317 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2318 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2319 if (EQ (tail, tailing))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2320 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2321 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2322 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2324 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2325 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2326 return XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2327 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2328
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2329 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2330 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2331 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2332 else if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2333 (check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2334 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2335 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2336 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2337 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2338 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2339 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2340 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2341 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2342 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2343 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2344 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2345 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2346 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2347 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2348
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2349 if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2350 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2351 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2352 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2353
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2354 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2355 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2356 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2357 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2358 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2359
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2360 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2361 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2362 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2363 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2364
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2365 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2366 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2367
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2368 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2369 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2370
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2371 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2372 remassoc_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2373 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2374 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2375 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2376 internal_equal (key, XCAR (elt), 0)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2377 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2378 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2379
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2380 /* no quit, no errors; be careful */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2382 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2383 remassq_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2384 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2385 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2386 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2387 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2388 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2389 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2391 /* Like Fremrassq, fast and unsafe; be careful */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2392 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2393 remrassq_no_quit (Lisp_Object value, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2395 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2396 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2397 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2398 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2399 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2400
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2401 /* Remove duplicate elements between START and END from LIST, a non-nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2402 list; if COPY is zero, do so destructively. Items to delete are selected
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2403 according to the algorithm used when :from-end t is passed to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2404 #'delete-duplicates. Error if LIST is ill-formed or circular.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2405
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2406 TEST and KEY are as in #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2407 reflect them, having been initialised with get_check_match_function() or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2408 get_check_test_function(). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2409 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2410 list_delete_duplicates_from_end (Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2411 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2412 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2413 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2414 Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2415 Lisp_Object end, Boolint copy)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2416 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2417 Lisp_Object checking = Qnil, result = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2418 Lisp_Object keyed, positioned, position_cons = Qnil, result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2419 Elemcount len = XFIXNUM (Flength (list)), pos, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2420 Elemcount ending = (NILP (end) ? len : XFIXNUM (end)), greatest_pos_seen = -1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2421 Elemcount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2422 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2423
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2424 /* We can't delete (or remove) as we go, because that breaks START and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2425 END. We could if END were nil, and that would change an ON(N + 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2426 algorithm to an ON^2 algorithm. Here and now it doesn't matter, though,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2427 #'delete-duplicates is relatively expensive no matter what. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2428 struct Lisp_Bit_Vector *deleting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2429 = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2430 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2431 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2432 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2433
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2434 check_sequence_range (list, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2435
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2436 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2437 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2438 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2439
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2440 GCPRO1 (keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2441
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2443 GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2444 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2445 if (!(starting <= ii && ii <= ending) \|\| bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2446 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2447 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2448 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2449 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2450
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2451 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2452 checking = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2453 pos = ii + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2455 while (!NILP ((positioned = list_position_cons_before
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2456 (&position_cons, keyed, checking, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2457 test_not_unboundp, test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2458 make_fixnum (max (starting - pos, 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2459 make_fixnum (ending - pos)))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2460 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2461 pos = XFIXNUM (positioned) + pos;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2462 set_bit_vector_bit (deleting, pos, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2463 greatest_pos_seen = max (greatest_pos_seen, pos);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2464 checking = NILP (position_cons) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2465 XCDR (checking) : XCDR (XCDR (position_cons));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2466 pos += 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2467 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2468 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2469 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2470 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2473 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2474
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2475 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2477 if (greatest_pos_seen > -1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2478 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2479 if (copy)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2480 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2481 result = result_tail = Fcons (XCAR (list), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2482 list = XCDR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2483 ii = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2484
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2485 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2486 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2487 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2488 if (ii == greatest_pos_seen)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2489 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2490 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2491 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2492 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2493 else if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2494 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2495 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2496 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2497 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2498 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2500 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2501 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2502 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2503 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2504 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2505 bit_vector_bit (deleting, ii++));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2506 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2507 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2508
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2509 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2511
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2512 DEFUN ("delete-duplicates", Fdelete_duplicates, 1, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2513 Remove all duplicate elements from SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2514
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2515 If SEQUENCE is a list and has duplicates, modify and return it. Note that
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2516 SEQUENCE may start with an element to be deleted; because of this, if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2517 modifying a variable, be sure to write `(setq VARIABLE (delete-duplicates
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2518 VARIABLE))' to be certain to have a list without duplicate elements.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2519
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2520 If SEQUENCE is an array and has duplicates, return a newly-allocated array
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2521 of the same type comprising all unique elements of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2522
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2523 If there are no duplicate elements in SEQUENCE, return it unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2524
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2525 See `remove*' for the meaning of the keywords. See `remove-duplicates' for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2526 a non-destructive version of this function.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2527
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2528 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2529 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2530 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2531 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2532 Lisp_Object sequence = args[0], keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2533 Lisp_Object positioned = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2534 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, len, ii = 0, jj = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2535 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2536 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2537 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2538
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2539 PARSE_KEYWORDS (Fdelete_duplicates, nargs, args, 6,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2540 (test, key, test_not, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2541 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2542
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2543 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2544 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2545 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2546
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2547 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2548 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2549 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2550 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2551 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2552
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2553 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2554
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2555 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2556 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2558 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2559 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2560 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2561 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2562 Lisp_Object prev_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2563 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2565 GCPRO2 (keyed, prev_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2566
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2567 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2568 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2569 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2570 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2571 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2572 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2573 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2574 = list_position_cons_before (&ignore, keyed,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2575 XCDR (tail), check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2576 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2577 0, make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2578 - (ii + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2579 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2580 make_fixnum (ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2581 - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2582 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2583 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2584 sequence = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2585 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2586 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2587 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2589 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2590 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2591 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2592 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2593 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2594 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2595 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2596
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2597 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2599 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2600 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2601 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2602 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2603 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2604 if (!(starting <= ii && ii <= ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2605 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2606 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2607 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2608 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2609 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2610
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2611 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2612 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2613 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2614 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2615 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2616 make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2617 - (ii + 1), 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2618 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2619 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2620 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2621 /* We know this isn't the first iteration of the loop,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2622 because we advanced above to the point where we have at
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2623 least one non-duplicate entry at the head of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2624 list. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2625 XSETCDR (prev_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2626 len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2627 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2628 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2629 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2631 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2632 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2633 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2634 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2635 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2636 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2637
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2638 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2640 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2641 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2642
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2643 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2644
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2645 if ((ii < starting \|\| (ii < ending && !NILP (end))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2646 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2647 check_sequence_range (args[0], start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2648 make_fixnum (deleted
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2649 + XFIXNUM (Flength (args[0]))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2650 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2651 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2652 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2653 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2654 sequence = list_delete_duplicates_from_end (sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2655 test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2656 test, key, start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2657 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2658 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2659 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2660 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2661 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2662 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2664 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2666 /* We know all the elements will be characters; set check_test to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2667 reflect that. This isn't useful if KEY is not #'identity, since
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2668 it may return non-characters for the elements. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2669 check_test = get_check_test_function (make_char ('a'),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2670 &test, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2671 Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2672 &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2673 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2674
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2675 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2676 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2677 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2678 Ibyte staging = alloca_ibytes (byte_len), staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2679 Ibyte cursor = XSTRING_DATA (sequence), startp = cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2680 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2682 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2683
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2684 while (cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2686 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2687 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2688 Ibyte *cursor0 = cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2689 Bytecount cursor0_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2690 Boolint delete_this = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2692 elt = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2693 INC_IBYTEPTR (cursor0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2694 cursor0_offset = cursor0 - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2696 for (jj = ii + 1; jj < ending && cursor0_offset < byte_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2697 jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2698 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2699 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2700 make_char (itext_ichar (cursor0)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2701 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2702 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2703 delete_this = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2704 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2705 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2706 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2707
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2708 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2709 cursor0 = startp + cursor0_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2710 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2711 \|\| !valid_ibyteptr_p (cursor0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2712 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2713 mapping_interaction_error (Qdelete_duplicates,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2714 sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2715 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2717 INC_IBYTEPTR (cursor0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2718 cursor0_offset = cursor0 - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2719 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2721 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2722 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2724 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2725 \|\| !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2726 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2727 mapping_interaction_error (Qdelete_duplicates, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2728 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2729
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2730 if (!delete_this)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2731 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2732 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2733 += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2734
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2735 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2736 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2737 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2739 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2740 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2742 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2743 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2744 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2745 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2747 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2749 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2750 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2751 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2752 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2754 if (0 != deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2755 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2756 sequence = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2757 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2758 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2759 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2760 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2761 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2762 Ibyte *staging = alloca_ibytes ((len = string_char_length (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2763 * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2764 Ibyte staging_cursor = staging, startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2765 Ibyte *endp = startp + XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2766 struct Lisp_Bit_Vector *deleting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2767 = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2768 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2769 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2770 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2771
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2772 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2774 /* For the from_end t case; transform contents to an array with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2775 elements addressable in constant time, use the same algorithm
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2776 as for vectors. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2777 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2778 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2779 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2781 while (startp < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2782 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2783 itext_copy_ichar (startp, staging + (ii * MAX_ICHAR_LEN));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2784 INC_IBYTEPTR (startp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2785 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2786 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2787
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2788 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2789
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2790 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2791
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2792 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2793 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2794 elt = KEY (key, make_char (itext_ichar (staging +
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2795 (ii * MAX_ICHAR_LEN))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2796 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2797 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2798 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2799 make_char (itext_ichar
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2800 (staging + (jj * MAX_ICHAR_LEN))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2801 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2802 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2803 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2804 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2805 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2806 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2807 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2808 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2810 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2812 if (0 != deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2813 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2814 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2815
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2816 for (ii = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2817 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2818 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2819 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2820 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2821 += itext_copy_ichar (startp, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2822 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2823
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2824 INC_IBYTEPTR (startp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2825 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2826
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2827 sequence = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2828 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2829 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2830 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2831 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2832 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2833 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2834 Lisp_Object *content = XVECTOR_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2835 struct Lisp_Bit_Vector *deleting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2836 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2837
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2838 len = XVECTOR_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2839 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2840
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2841 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2842 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2843 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2844 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2845 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2846 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2847 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2848
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2849 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2850
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2851 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2852
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2853 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2854 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2855 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2856 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2857 elt = KEY (key, content[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2859 for (jj = ii + 1; jj < ending; jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2860 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2861 if (check_test (test, key, elt, content[jj])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2862 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2863 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2864 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2865 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2866 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2867 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2868 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2869 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2870 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2871 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2872 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2873 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2874 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2875 elt = KEY (key, content[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2876
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2877 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2878 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2879 if (check_test (test, key, elt, content[jj])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2880 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2881 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2882 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2883 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2884 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2885 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2886 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2887 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2889
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2890 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2891
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2892 if (deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2893 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2894 Lisp_Object res = make_vector (len - deleted, Qnil),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2895 *res_content = XVECTOR_DATA (res);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2897 for (ii = jj = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2898 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2899 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2900 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2901 res_content[jj++] = content[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2902 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2903 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2905 sequence = res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2906 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2907 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2908 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2909 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2910 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2911 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2912 /* I'm a little irritated at this. Basically, the only reasonable
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2913 thing delete-duplicates should do if handed a bit vector is return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2914 something of maximum length two and minimum length 0 (because
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2915 that's the possible number of distinct elements if EQ is regarded
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2916 as identity, which it should be). But to support arbitrary TEST
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2917 and KEY arguments, which may be non-deterministic from our
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2918 perspective, we need the same algorithm as for vectors. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2919 struct Lisp_Bit_Vector *deleting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2920 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2921
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2922 len = bit_vector_length (bv);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2923
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2924 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2925 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2926 /* We know all the elements will be bits; set check_test to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2927 reflect that. This isn't useful if KEY is not #'identity, since
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2928 it may return non-bits for the elements. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2929 check_test = get_check_test_function (Qzero, &test, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2930 Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2931 &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2932 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2933
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2934 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2935
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2936 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2937 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2938 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2939 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2940 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2941 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2942 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2944 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2945
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2946 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2947
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2948 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2949 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2950 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2951 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2952 elt = KEY (key, make_fixnum (bit_vector_bit (bv, ii)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2954 for (jj = ii + 1; jj < ending; jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2955 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2956 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2957 make_fixnum (bit_vector_bit (bv, jj)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2958 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2959 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2960 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2961 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2962 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2963 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2965 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2966 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2967 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2968 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2969 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2970 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2971 elt = KEY (key, make_fixnum (bit_vector_bit (bv, ii)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2972
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2973 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2974 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2975 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2976 make_fixnum (bit_vector_bit (bv, jj)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2977 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2978 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2979 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2980 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2981 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2982 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2983 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2984 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2985 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2986
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2987 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2988
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2989 if (deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2990 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2991 Lisp_Object res = make_bit_vector (len - deleted, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2992 Lisp_Bit_Vector *resbv = XBIT_VECTOR (res);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2993
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2994 for (ii = jj = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2995 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2996 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2998 set_bit_vector_bit (resbv, jj++, bit_vector_bit (bv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	2999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3000 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3001
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3002 sequence = res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3003 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3005
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3006 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3007 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3008
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3009 DEFUN ("remove-duplicates", Fremove_duplicates, 1, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3010 Remove duplicate elements from SEQUENCE, non-destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3011
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3012 If there are no duplicate elements in SEQUENCE, return it unmodified;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3013 otherwise, return a new object. If SEQUENCE is a list, the new object may
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3014 share list structure with SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3016 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3017
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3018 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3019 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3020 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3021 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3022 Lisp_Object sequence = args[0], keyed, positioned = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3023 Lisp_Object result = sequence, result_tail = result, cursor = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3024 Lisp_Object cons_with_shared_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3025 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3026 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3027 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3028 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3029
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3030 PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3031 (test, key, test_not, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3032 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3033
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3034 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3036 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3037 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3038 return Fdelete_duplicates (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3039 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3041 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3042 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3043
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3044 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3045 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3046 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3047 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3048 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3049
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3050 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3051 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3052 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3053 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3054
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3055 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3056 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3057
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3058 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3059 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3060 Lisp_Object ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3061
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3062 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3063
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3064 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3065 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3066 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3067 if (starting <= ii && ii <= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3068 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3069 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3070 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3071 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3072 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3073 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3074 make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3075 - (ii + 1), 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3076 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3077 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3078 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3079 sequence = result = result_tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3080 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3081 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3082 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3083 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3084 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3085 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3086 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3087 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3088 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3089 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3090
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3091 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3092 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3093 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3094 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3095
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3096 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3097 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3098 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3099 if (!(starting <= ii && ii <= ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3101 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3102 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3105 /* For this algorithm, each time we encounter an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3106 removed, copy the output list from the tail beyond the last
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3107 removed cons to this one. Otherwise, the tail of the output list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3108 is shared with the input list, which is OK. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3109
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3110 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3111 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3112 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3113 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3114 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3115 make_fixnum (max (starting - (ii + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3116 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3117 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3118 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3119 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3120 if (EQ (result, sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3121 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3122 result = cons_with_shared_tail
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3123 = Fcons (XCAR (sequence), XCDR (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3124 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3125
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3126 result_tail = cons_with_shared_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3127 cursor = XCDR (cons_with_shared_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3128
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3129 while (!EQ (cursor, tail) && !NILP (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3131 XSETCDR (result_tail, Fcons (XCAR (cursor), Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3132 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3133 cursor = XCDR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3134 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3135
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3136 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3137 cons_with_shared_tail = result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3138 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3139
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3140 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3142 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3143 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3144
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3145 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3146
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3147 if ((ii < starting \|\| (ii < ending && !NILP (end))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3148 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3149 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3150 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3151 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3152 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3153 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3154 result = list_delete_duplicates_from_end (sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3155 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3156 start, end, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3157 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3158
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3159 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3160 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3161 #undef KEY
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3162
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3163 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3164 Reverse SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3165
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3166 Return the beginning of the reversed sequence, which will be a distinct Lisp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3167 object if SEQUENCE is a list with length greater than one. See also
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3168 `reverse', the non-destructive version of this function.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3169 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3170 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3172 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3173
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3174 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3175 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3176 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3177 Lisp_Object prev = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3178 Lisp_Object tail = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3179
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3180 /* We gcpro our args; see `nconc' */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3181 GCPRO2 (prev, tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3182 while (!NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3183 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3184 REGISTER Lisp_Object next;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3185 CONCHECK_CONS (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3186 next = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3187 XCDR (tail) = prev;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3188 prev = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3189 tail = next;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3190 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3191 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3192 return prev;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3193 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3194 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3195 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3196 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3197 Elemcount half = length / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3198 Lisp_Object swap = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3199 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3200
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3201 while (ii > half)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3202 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3203 swap = XVECTOR_DATA (sequence) [length - ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3204 XVECTOR_DATA (sequence) [length - ii]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3205 = XVECTOR_DATA (sequence) [ii - 1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3206 XVECTOR_DATA (sequence) [ii - 1] = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3207 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3208 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3209 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3210 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3211 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3212 Elemcount length = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3213 Ibyte staging = alloca_ibytes (length), staging_end = staging + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3214 Ibyte cursor = XSTRING_DATA (sequence), endp = cursor + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3215
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3216 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3217 while (cursor < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3218 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3219 staging_end -= itext_ichar_len (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3220 itext_copy_ichar (cursor, staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3221 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3222 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3223
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3224 assert (staging == staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3225
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3226 memcpy (XSTRING_DATA (sequence), staging, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3227 init_string_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3228 bump_string_modiff (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3229 sledgehammer_check_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3230 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3231 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3232 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3233 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3234 Elemcount length = bit_vector_length (bv), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3235 Elemcount half = length / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3236 int swap = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3237
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3238 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3239 while (ii > half)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3240 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3241 swap = bit_vector_bit (bv, length - ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3242 set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3243 set_bit_vector_bit (bv, ii - 1, swap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3244 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3245 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3246 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3247 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3248 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3249 assert (NILP (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3250 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3251
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3252 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3253 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3254
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3255 DEFUN ("reverse", Freverse, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3256 Reverse SEQUENCE, copying. Return the reversed sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3257 See also the function `nreverse', which is used more often.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3258 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3259 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3260 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3261 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3262
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3263 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3264
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3265 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3266 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3267 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3268 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3269 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3270 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3271 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3272 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3273 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3274 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3275 Lisp_Object *staging = alloca_array (Lisp_Object, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3276
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3277 while (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3278 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3279 staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3280 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3281 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3282
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3283 result = Fvector (length, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3284 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3285 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3286 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3287 Elemcount length = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3288 Ibyte staging = alloca_ibytes (length), staging_end = staging + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3289 Ibyte cursor = XSTRING_DATA (sequence), endp = cursor + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3290
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3291 while (cursor < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3292 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3293 staging_end -= itext_ichar_len (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3294 itext_copy_ichar (cursor, staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3295 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3296 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3298 assert (staging == staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3299
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3300 result = make_string (staging, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3301 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3302 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3303 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3304 Lisp_Bit_Vector bv = XBIT_VECTOR (sequence), res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3305 Elemcount length = bit_vector_length (bv), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3306
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3307 result = make_bit_vector (length, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3308 res = XBIT_VECTOR (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3309
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3310 while (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3311 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3312 set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3313 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3314 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3316 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3317 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3318 assert (NILP (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3319 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3320
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3321 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3324 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3325 list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3326 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3327 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3328 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3329 Lisp_Object value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3330 Lisp_Object tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3331 Lisp_Object tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3332 Lisp_Object l1, l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3333 Lisp_Object tortoises[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3334 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3335 int l1_count = 0, l2_count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3336
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3337 l1 = org_l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3338 l2 = org_l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3339 tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3340 value = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3341 tortoises[0] = org_l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3342 tortoises[1] = org_l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3343
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3344 /* It is sufficient to protect org_l1 and org_l2. When l1 and l2 are
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3345 updated, we copy the new values back into the org_ vars. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3346
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3347 GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3348 gcpro5.nvars = 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3349
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3350 while (1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3351 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3352 if (NILP (l1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3353 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3354 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3355 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3356 return l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3357 Fsetcdr (tail, l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3358 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3359 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3360 if (NILP (l2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3361 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3362 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3363 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3364 return l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3365 Fsetcdr (tail, l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3366 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3367 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3369 if (check_merge (predicate, key, Fcar (l2), Fcar (l1)) == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3370 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3371 tem = l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3372 l1 = Fcdr (l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3373 org_l1 = l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3374
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3375 if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3376 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3377 if (l1_count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3378 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3379 if (!CONSP (tortoises[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3380 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3381 mapping_interaction_error (Qmerge, tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3382 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3383
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3384 tortoises[0] = XCDR (tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3385 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3387 if (EQ (org_l1, tortoises[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3388 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3389 signal_circular_list_error (org_l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3390 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3391 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3393 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3395 tem = l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3396 l2 = Fcdr (l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3397 org_l2 = l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3398
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3399 if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3401 if (l2_count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3402 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3403 if (!CONSP (tortoises[1]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3404 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3405 mapping_interaction_error (Qmerge, tortoises[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3406 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3407
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3408 tortoises[1] = XCDR (tortoises[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3409 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3410
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3411 if (EQ (org_l2, tortoises[1]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3412 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3413 signal_circular_list_error (org_l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3414 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3416 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3417
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3418 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3419 value = tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3420 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3421 Fsetcdr (tail, tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3422
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3423 tail = tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3424 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3425 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3426
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3427 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3428 array_merge (Lisp_Object *dest, Elemcount dest_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3429 Lisp_Object *front, Elemcount front_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3430 Lisp_Object *back, Elemcount back_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3431 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3432 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3433 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3434 Elemcount ii, fronting, backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3435 Lisp_Object *front_staging = front;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3436 Lisp_Object *back_staging = back;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3437 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3438
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3439 assert (dest_len == (back_len + front_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3441 if (0 == dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3443 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3444 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3445
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3446 if (front >= dest && front < (dest + dest_len))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3447 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3448 front_staging = alloca_array (Lisp_Object, front_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3449
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3450 for (ii = 0; ii < front_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3451 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3452 front_staging[ii] = front[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3453 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3454 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3455
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3456 if (back >= dest && back < (dest + dest_len))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3458 back_staging = alloca_array (Lisp_Object, back_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3459
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3460 for (ii = 0; ii < back_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3461 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3462 back_staging[ii] = back[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3463 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3464 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3465
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3466 GCPRO2 (front_staging[0], back_staging[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3467 gcpro1.nvars = front_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3468 gcpro2.nvars = back_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3470 for (ii = fronting = backing = 0; ii < dest_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3471 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3472 if (fronting >= front_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3473 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3474 while (ii < dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3475 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3476 dest[ii] = back_staging[backing];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3477 ++ii, ++backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3478 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3479 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3480 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3481 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3482
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3483 if (backing >= back_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3484 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3485 while (ii < dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3486 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3487 dest[ii] = front_staging[fronting];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3488 ++ii, ++fronting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3489 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3490 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3491 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3492 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3493
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3494 if (check_merge (predicate, key, back_staging[backing],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3495 front_staging[fronting]) == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3496 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3497 dest[ii] = front_staging[fronting];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3498 ++fronting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3500 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3501 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3502 dest[ii] = back_staging[backing];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3503 ++backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3504 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3505 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3506
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3507 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3508 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3509
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3510 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3511 list_array_merge_into_list (Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3512 Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3513 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3514 Lisp_Object predicate, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3515 Boolint reverse_order)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3516 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3517 Lisp_Object tail = Qnil, value = Qnil, tortoise = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3518 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3519 Elemcount array_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3520 int looped = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3521
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3522 GCPRO4 (list, tail, value, tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3523
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3524 while (1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3525 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3526 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3527 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3528 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3529
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3530 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3531 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3532 return Flist (array_len, array);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3533 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3534
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3535 Fsetcdr (tail, Flist (array_len - array_index, array + array_index));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3536 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3537 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3538
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3539 if (array_index >= array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3540 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3541 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3542 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3543 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3544 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3545 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3546
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3547 Fsetcdr (tail, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3548 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3549 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3550
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3551
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3552 if (reverse_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3553 check_merge (predicate, key, Fcar (list), array [array_index])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3554 : !check_merge (predicate, key, array [array_index], Fcar (list)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3555 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3556 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3557 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3558 value = tail = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3559 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3560 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3561 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3562 Fsetcdr (tail, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3563 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3564 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3565
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3566 list = Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3567 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3568 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3569 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3570 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3571 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3572 value = tail = Fcons (array [array_index], Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3573 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3574 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3575 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3576 Fsetcdr (tail, Fcons (array [array_index], tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3577 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3578 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3579 ++array_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3580 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3582 if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3583 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3584 if (looped & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3585 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3586 tortoise = XCDR (tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3587 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3589 if (EQ (list, tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3590 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3591 signal_circular_list_error (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3592 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3593 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3594 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3595 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3596
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3597 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3598 list_list_merge_into_array (Lisp_Object *output, Elemcount output_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3599 Lisp_Object list_one, Lisp_Object list_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3600 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3601 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3602 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3603 Elemcount output_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3604
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3605 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3606 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3607 if (NILP (list_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3609 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3610 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3611 output [output_index] = Fcar (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3612 list_two = Fcdr (list_two), ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3613 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3614 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3615 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3616
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3617 if (NILP (list_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3618 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3619 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3620 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3621 output [output_index] = Fcar (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3622 list_one = Fcdr (list_one), ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3623 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3624 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3627 if (check_merge (predicate, key, Fcar (list_two), Fcar (list_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3628 == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3629 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3630 output [output_index] = XCAR (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3631 list_one = XCDR (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3632 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3633 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3634 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3635 output [output_index] = XCAR (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3636 list_two = XCDR (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3637 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3638
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3639 ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3640
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3641 /* No need to check for circularity. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3643 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3644
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3645 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3646 list_array_merge_into_array (Lisp_Object *output, Elemcount output_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3647 Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3648 Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3649 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3650 Lisp_Object predicate, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3651 Boolint reverse_order)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3653 Elemcount output_index = 0, array_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3654
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3655 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3656 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3657 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3658 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3659 if (array_len - array_index != output_len - output_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3661 mapping_interaction_error (Qmerge, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3664 while (array_index < array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3666 output [output_index++] = array [array_index++];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3667 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3668
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3669 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3670 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3671
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3672 if (array_index >= array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3673 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3674 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3675 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3676 output [output_index++] = Fcar (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3677 list = Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3678 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3679
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3680 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3681 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3682
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3683 if (reverse_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3684 check_merge (predicate, key, Fcar (list), array [array_index]) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3685 !check_merge (predicate, key, array [array_index], Fcar (list)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3686 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3687 output [output_index] = XCAR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3688 list = XCDR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3689 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3690 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3691 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3692 output [output_index] = array [array_index];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3693 ++array_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3694 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3696 ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3697 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3698 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3700 #define STRING_DATA_TO_OBJECT_ARRAY(strdata, c_array, counter, len) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3701 do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3702 c_array = alloca_array (Lisp_Object, len); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3703 for (counter = 0; counter < len; ++counter) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3704 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3705 c_array[counter] = make_char (itext_ichar (strdata)); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3706 INC_IBYTEPTR (strdata); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3707 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3708 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3709
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3710 #define BIT_VECTOR_TO_OBJECT_ARRAY(v, c_array, counter, len) do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3711 c_array = alloca_array (Lisp_Object, len); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3712 for (counter = 0; counter < len; ++counter) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3713 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3714 c_array[counter] = make_fixnum (bit_vector_bit (v, counter)); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3715 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3716 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3718 DEFUN ("merge", Fmerge, 4, MANY, 0, /*
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	3719 Destructively merge SEQUENCE1 and SEQUENCE2, producing a new sequence.
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3721 TYPE is the type of sequence to return. PREDICATE is a `less-than'
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3722 predicate on the elements.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3724 Optional keyword argument KEY is a function used to extract an object to be
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	3725 used for comparison from each element of SEQUENCE1 and SEQUENCE2.
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	3726
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	3727 arguments: (TYPE SEQUENCE1 SEQUENCE2 PREDICATE &key (KEY #'IDENTITY))
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3728 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3729 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3730 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3731 Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3732 predicate = args[3], result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3733 check_test_func_t check_merge = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3734
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3735 PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3736
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3737 CHECK_SEQUENCE (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3738 CHECK_SEQUENCE (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3739
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3740 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3742 check_merge = get_merge_predicate (predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3743
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3744 if (EQ (type, Qlist) && (LISTP (sequence_one) \|\| LISTP (sequence_two)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3745 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3746 if (NILP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3747 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3748 result = Fappend (2, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3749 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3750 else if (NILP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3751 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3752 args[3] = Qnil; /* Overwriting PREDICATE, and losing its GC
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3753 protection, but that doesn't matter. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3754 result = Fappend (2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3755 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3756 else if (CONSP (sequence_one) && CONSP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3757 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3758 result = list_merge (sequence_one, sequence_two, check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3759 predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3760 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3761 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3762 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3763 Lisp_Object *array_storage, swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3764 Elemcount array_length, i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3765 Boolint reverse_order = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3767 if (!CONSP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3768 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3769 /* Make sequence_one the cons, sequence_two the array: */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3770 swap = sequence_one;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3771 sequence_one = sequence_two;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3772 sequence_two = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3773 reverse_order = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3774 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3775
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3776 if (VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3777 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3778 array_storage = XVECTOR_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3779 array_length = XVECTOR_LENGTH (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3780 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3781 else if (STRINGP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3782 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3783 Ibyte *strdata = XSTRING_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3784 array_length = string_char_length (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3785 /* No need to GCPRO, characters are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3786 STRING_DATA_TO_OBJECT_ARRAY (strdata, array_storage, i,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3787 array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3788
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3789 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3790 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3791 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3792 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3793 array_length = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3794 /* No need to GCPRO, fixnums are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3795 BIT_VECTOR_TO_OBJECT_ARRAY (v, array_storage, i, array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3796 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3797
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3798 result = list_array_merge_into_list (sequence_one,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3799 array_storage, array_length,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3800 check_merge, predicate, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3801 reverse_order);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3802 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3804 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3805 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3806 Elemcount sequence_one_len = XFIXNUM (Flength (sequence_one)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3807 sequence_two_len = XFIXNUM (Flength (sequence_two)), i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3808 Elemcount output_len = 1 + sequence_one_len + sequence_two_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3809 Lisp_Object *output = alloca_array (Lisp_Object, output_len),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3810 sequence_one_storage = NULL, sequence_two_storage = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3811 Boolint do_coerce = !(EQ (type, Qvector) \|\| EQ (type, Qstring)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3812 \|\| EQ (type, Qbit_vector) \|\| EQ (type, Qlist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3813 Ibyte *strdata = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3814 Lisp_Bit_Vector *v = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3815 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3817 output[0] = do_coerce ? Qlist : type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3818 for (i = 1; i < output_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3819 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3820 output[i] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3821 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3823 GCPRO1 (output[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3824 gcpro1.nvars = output_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3825
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3826 if (VECTORP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3827 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3828 sequence_one_storage = XVECTOR_DATA (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3829 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3830 else if (STRINGP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3831 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3832 strdata = XSTRING_DATA (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3833 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3834 i, sequence_one_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3835 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3836 else if (BIT_VECTORP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3837 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3838 v = XBIT_VECTOR (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3839 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3840 i, sequence_one_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3841 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3842
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3843 if (VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3845 sequence_two_storage = XVECTOR_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3847 else if (STRINGP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3848 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3849 strdata = XSTRING_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3850 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3851 i, sequence_two_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3852 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3853 else if (BIT_VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3854 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3855 v = XBIT_VECTOR (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3856 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3857 i, sequence_two_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3858 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3859
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3860 if (LISTP (sequence_one) && LISTP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3861 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3862 list_list_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3863 sequence_one, sequence_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3864 check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3865 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3866 else if (LISTP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3867 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3868 list_array_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3869 sequence_one,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3870 sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3871 sequence_two_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3872 check_merge, predicate, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3873 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3874 else if (LISTP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3875 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3876 list_array_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3877 sequence_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3878 sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3879 sequence_one_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3880 check_merge, predicate, key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3881 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3882 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3883 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3884 array_merge (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3885 sequence_one_storage, sequence_one_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3886 sequence_two_storage, sequence_two_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3887 check_merge, predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3888 key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3889 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3890
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3891 result = Ffuncall (output_len, output);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3892
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3893 if (do_coerce)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3895 result = call2 (Qcoerce, result, type);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3896 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3897
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3898 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3899 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3900
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3901 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3902 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3903
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3904 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3905 list_sort (Lisp_Object list, check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3906 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3907 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3908 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3909 Lisp_Object back, tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3910 Lisp_Object front = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3911 Lisp_Object len = Flength (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3912
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3913 if (XFIXNUM (len) < 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3914 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3915
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3916 len = make_fixnum (XFIXNUM (len) / 2 - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3917 tem = Fnthcdr (len, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3918 back = Fcdr (tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3919 Fsetcdr (tem, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3920
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3921 GCPRO4 (front, back, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3922 front = list_sort (front, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3923 back = list_sort (back, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3924
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3925 RETURN_UNGCPRO (list_merge (front, back, check_merge, predicate, key));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3926 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3927
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3928 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3929 array_sort (Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3930 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3931 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3932 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3933 Elemcount split;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3935 if (array_len < 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3936 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3937
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3938 split = array_len / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3939
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3940 array_sort (array, split, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3941 array_sort (array + split, array_len - split, check_merge, predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3942 key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3943 array_merge (array, array_len, array, split, array + split,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3944 array_len - split, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3945 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3947 DEFUN ("sort", FsortX, 2, MANY, 0, /
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3948 Sort SEQUENCE, comparing elements using PREDICATE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3949 Returns the sorted sequence. SEQUENCE is modified by side effect.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3951 PREDICATE is called with two elements of SEQUENCE, and should return t if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3952 the first element is `less' than the second.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3954 Optional keyword argument KEY is a function used to extract an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3955 used for comparison from each element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3956
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3957 In this implementation, sorting is always stable; but call `stable-sort' if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3958 this stability is important to you, other implementations may not make the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3959 same guarantees.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3961 arguments: (SEQUENCE PREDICATE &key (KEY #'IDENTITY))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3962 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3963 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3964 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3965 Lisp_Object sequence = args[0], predicate = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3966 Lisp_Object *sequence_carray;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3967 check_test_func_t check_merge = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3968 Elemcount sequence_len, i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3969
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3970 PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3972 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3973
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3974 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3975
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3976 check_merge = get_merge_predicate (predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3977
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3978 if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3979 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3980 sequence = list_sort (sequence, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3981 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3982 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3983 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3984 array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3985 check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3986 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3987 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3988 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3989 Ibyte *strdata = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3990
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3991 sequence_len = string_char_length (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3992
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3993 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3994
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3995 /* No GCPRO necessary, characters are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3996 array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3997
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3998 strdata = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	3999
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4000 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4001 for (i = 0; i < sequence_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4002 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4003 strdata += set_itext_ichar (strdata, XCHAR (sequence_carray[i]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4005
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4006 init_string_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4007 bump_string_modiff (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4008 sledgehammer_check_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4009 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4010 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4011 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4012 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4013 sequence_len = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4014
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4015 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4017 /* No GCPRO necessary, bits are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4018 array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4019
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4020 for (i = 0; i < sequence_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4021 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4022 set_bit_vector_bit (v, i, XFIXNUM (sequence_carray [i]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4023 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4024 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4025
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4026 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4027 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4028
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4029
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4030 static Lisp_Object replace_string_range_1 (Lisp_Object dest,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4031 Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4032 Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4033 const Ibyte *source,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4034 const Ibyte *source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4035 Lisp_Object item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4036
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4037 /* Fill the substring of DEST beginning at START and ending before END with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4038 the character ITEM. If DEST does not have sufficient space for END -
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4039 START characters at START, write as many as is possible without changing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4040 the character length of DEST. Update the string modification flag and do
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4041 any sledgehammer checks we have turned on.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4043 START must be a Lisp integer. END can be nil, indicating the length of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4044 string, or a Lisp integer. The condition (<= 0 START END (length DEST))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4045 must hold, or fill_string_range() will signal an error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4046 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4047 fill_string_range (Lisp_Object dest, Lisp_Object item, Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4048 Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4049 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4050 return replace_string_range_1 (dest, start, end, NULL, NULL, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4051 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4052
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4053 DEFUN ("fill", Ffill, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4054 Destructively modify SEQUENCE by replacing each element with ITEM.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4055 SEQUENCE is a list, vector, bit vector, or string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4056
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4057 Optional keyword START is the index of the first element of SEQUENCE
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4058 to be modified, and defaults to zero. Optional keyword END is the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4059 exclusive upper bound on the elements of SEQUENCE to be modified, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4060 defaults to the length of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4061
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4062 arguments: (SEQUENCE ITEM &key (START 0) (END (length SEQUENCE)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4063 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4064 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4065 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4066 Lisp_Object sequence = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4067 Lisp_Object item = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4068 Elemcount starting, ending = MOST_POSITIVE_FIXNUM + 1, ii, len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4069
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4070 PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4071
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4072 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4073 starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4074
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4075 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4076 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4077 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4078 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4080
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4081 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4082 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4083 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4084 CHECK_CHAR_COERCE_INT (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4085 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4086
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4087 fill_string_range (sequence, item, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4088 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4089 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4090 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4091 Lisp_Object *p = XVECTOR_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4092
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4093 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4094 len = XVECTOR_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4095
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4096 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4097 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4098
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4099 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4101 p[ii] = item;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4102 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4104 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4105 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4106 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4107 int bit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4108
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4109 CHECK_BIT (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4110 bit = XFIXNUM (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4111 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4112 len = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4113
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4114 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4115 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4116
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4117 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4119 set_bit_vector_bit (v, ii, bit);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4120 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4121 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4122 else if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4123 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4124 Elemcount counting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4125
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4127 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4128 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4129 if (counting >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4131 if (counting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4132 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4133 XSETCAR (tail, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4134 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4135 else if (counting == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4136 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4137 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4138 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4139 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4140 ++counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4142 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4143
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4144 if (counting < starting \|\| (counting != ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4145 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4146 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4148 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4149 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4150 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4151 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4152 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4153 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4154 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4155 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4156
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4157
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4158 /* Replace the substring of DEST beginning at START and ending before END
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4159 with the text at SOURCE, which is END - START characters long and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4160 SOURCE_LIMIT - SOURCE octets long. If DEST does not have sufficient
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4161 space for END - START characters at START, write as many as is possible
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4162 without changing the length of DEST. Update the string modification flag
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4163 and do any sledgehammer checks we have turned on in this build.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4164
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4165 START must be a Lisp integer. END can be nil, indicating the length of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4166 string, or a Lisp integer. The condition (<= 0 START END (length DEST))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4167 must hold, or replace_string_range() will signal an error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4168 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4169 replace_string_range (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4170 const Ibyte source, const Ibyte source_limit)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4172 return replace_string_range_1 (dest, start, end, source, source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4173 Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4174 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4175
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4176 /* This is the guts of several mapping functions.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4177
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4178 Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4179 taking the elements from SEQUENCES. If VALS is non-NULL, store the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4180 results into VALS, a C array of Lisp_Objects; else, if LISP_VALS is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4181 non-nil, store the results into LISP_VALS, a sequence with sufficient
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4182 room for CALL_COUNT results (but see the documentation of SOME_OR_EVERY.)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4183 Else, do not accumulate any result.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4184
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4185 If VALS is non-NULL, NSEQUENCES is one, and SEQUENCES[0] is a cons,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4186 mapcarX will store the elements of SEQUENCES[0] in stack and GCPRO them,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4187 so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4188 mapcarX.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4189
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4190 Otherwise, mapcarX signals an invalid state error (see
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4191 mapping_interaction_error(), above) if it encounters a non-cons,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4192 non-array when traversing SEQUENCES. Common Lisp specifies in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4193 MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4194 destructively modifies SEQUENCES in a way that might affect the ongoing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4195 traversal operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4196
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4197 CALLER is a symbol describing the Lisp-visible function that was called,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4198 and any errors thrown because SEQUENCES was modified will reflect it.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4199
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4200 If CALLER is Qsome, return the (possibly multiple) values given by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4201 FUNCTION the first time it is non-nil, and abandon the iterations.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4202 LISP_VALS must be the result of calling STORE_VOID_IN_LISP on the address
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4203 of a Lisp object, and the return value will be stored at that address.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4204 If CALLER is Qevery, LISP_VALS must also reflect a pointer to a Lisp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4205 object, and Qnil will be stored at that address if FUNCTION gives nil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4206 otherwise it will be left alone. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4207
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4208 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4209 mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4210 Lisp_Object function, int nsequences, Lisp_Object *sequences,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4211 Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4212 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4213 Lisp_Object called, *args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4214 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4215 Ibyte lisp_vals_staging = NULL, cursor = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4216 int i, j;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4217
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4218 assert ((EQ (caller, Qsome) \|\| EQ (caller, Qevery)) ? vals == NULL : 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4219
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4220 args = alloca_array (Lisp_Object, nsequences + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4221 args[0] = function;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4222 for (i = 1; i <= nsequences; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4223 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4224 args[i] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4225 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4227 if (vals != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4228 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4229 GCPRO2 (args[0], vals[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4230 gcpro1.nvars = nsequences + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4231 gcpro2.nvars = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4232 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4233 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4234 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4235 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4236 gcpro1.nvars = nsequences + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4237 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4238
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4239 /* Be extra nice in the event that we've been handed one list and one
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4240 only; make it possible for FUNCTION to set cdrs not yet processed to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4241 non-cons, non-nil objects without ill-effect, if we have been handed
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4242 the stack space to do that. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4243 if (vals != NULL && 1 == nsequences && CONSP (sequences[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4244 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4245 Lisp_Object lst = sequences[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4246 Lisp_Object *val = vals;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4247 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4248 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4249 *val++ = XCAR (lst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4250 lst = XCDR (lst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4251 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4252 gcpro2.nvars = call_count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4253
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4254 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4255 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4256 args[1] = vals[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4257 vals[i] = IGNORE_MULTIPLE_VALUES (Ffuncall (nsequences + 1, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4258 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4259 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4260 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4261 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4262 enum lrecord_type lisp_vals_type = lrecord_type_symbol;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4263 Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4264 for (j = 0; j < nsequences; ++j)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4266 sequence_types[j] = XRECORD_LHEADER (sequences[j])->type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4267 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4269 if (!EQ (caller, Qsome) && !EQ (caller, Qevery))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4270 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4271 assert (LRECORDP (lisp_vals));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4272
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4273 lisp_vals_type
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4274 = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4276 if (lrecord_type_string == lisp_vals_type)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4278 lisp_vals_staging = cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4279 = alloca_ibytes (call_count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4280 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4281 else if (ARRAYP (lisp_vals))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4283 CHECK_LISP_WRITEABLE (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4284 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4285 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4286
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4287 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4288 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4289 for (j = 0; j < nsequences; ++j)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4290 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4291 switch (sequence_types[j])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4292 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4293 case lrecord_type_cons:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4294 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4295 if (!CONSP (sequences[j]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4296 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4297 /* This means FUNCTION has messed around with a cons
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4298 in one of the sequences, since we checked the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4299 type (CHECK_SEQUENCE()) and the length and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4300 structure (with Flength()) correctly in our
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4301 callers. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4302 mapping_interaction_error (caller, sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4303 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4304 args[j + 1] = XCAR (sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4305 sequences[j] = XCDR (sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4306 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4307 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4308 case lrecord_type_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4309 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4310 args[j + 1] = XVECTOR_DATA (sequences[j])[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4311 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4312 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4313 case lrecord_type_string:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4314 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4315 args[j + 1] = make_char (string_ichar (sequences[j], i));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4316 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4317 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4318 case lrecord_type_bit_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4319 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4320 args[j + 1]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4321 = make_fixnum (bit_vector_bit (XBIT_VECTOR (sequences[j]),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4322 i));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4323 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4324 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4325 default:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4326 ABORT();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4327 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4328 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4329 called = Ffuncall (nsequences + 1, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4330 if (vals != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4331 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4332 vals[i] = IGNORE_MULTIPLE_VALUES (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4333 gcpro2.nvars += 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4334 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4335 else if (EQ (Qsome, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4336 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4337 if (!NILP (IGNORE_MULTIPLE_VALUES (called)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4338 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4339 Lisp_Object *result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4340 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4341 *result = called;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4342 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4343 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4344 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4345 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4346 else if (EQ (Qevery, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4347 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4348 if (NILP (IGNORE_MULTIPLE_VALUES (called)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4349 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4350 Lisp_Object *result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4351 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4352 *result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4353 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4354 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4355 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4356 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4357 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4359 called = IGNORE_MULTIPLE_VALUES (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4360 switch (lisp_vals_type)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4361 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4362 case lrecord_type_symbol:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4363 /* Discard the result of funcall. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4364 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4365 case lrecord_type_cons:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4366 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4367 if (!CONSP (lisp_vals))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4368 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4369 /* If FUNCTION has inserted a non-cons non-nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4370 cdr into the list before we've processed the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4371 relevant part, error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4372 mapping_interaction_error (caller, lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4373 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4374 XSETCAR (lisp_vals, called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4375 lisp_vals = XCDR (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4376 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4377 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4378 case lrecord_type_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4379 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4380 i < XVECTOR_LENGTH (lisp_vals) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4381 (XVECTOR_DATA (lisp_vals)[i] = called) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4382 /* Let #'aset error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4383 Faset (lisp_vals, make_fixnum (i), called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4384 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4385 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4386 case lrecord_type_string:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4387 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4388 CHECK_CHAR_COERCE_INT (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4389 cursor += set_itext_ichar (cursor, XCHAR (called));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4390 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4391 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4392 case lrecord_type_bit_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4393 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4394 (BITP (called) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4395 i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4396 set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4397 XFIXNUM (called)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4398 (void) Faset (lisp_vals, make_fixnum (i), called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4399 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4400 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4401 default:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4402 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4403 ABORT();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4404 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4405 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4406 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4407 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4408 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4409
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4410 if (lisp_vals_staging != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4411 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4412 CHECK_LISP_WRITEABLE (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4413 replace_string_range (lisp_vals, Qzero, make_fixnum (call_count),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4414 lisp_vals_staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4416 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4417
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4418 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4419 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4420
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4421 /* Given NSEQUENCES objects at the address pointed to by SEQUENCES, return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4422 the length of the shortest sequence. Error if all are circular, or if any
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4423 one of them is not a sequence. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4424 static Elemcount
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4425 shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4426 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4427 Elemcount len = 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4428 Lisp_Object length = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4429 int i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4430
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4431 for (i = 0; i < nsequences; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4432 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4433 if (CONSP (sequences[i]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4435 length = Flist_length (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4436 if (!NILP (length))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4437 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4438 len = min (len, XFIXNUM (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4439 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4440 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4441 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4443 CHECK_SEQUENCE (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4444 length = Flength (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4445 len = min (len, XFIXNUM (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4446 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4447 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4448
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4449 if (len == 1 + MOST_POSITIVE_FIXNUM)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4450 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4451 signal_circular_list_error (sequences[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4452 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4453
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4454 return len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4455 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4456
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4457 DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4458 Call FUNCTION on each element of SEQUENCE, and concat results to a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4459 Between each pair of results, insert SEPARATOR.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4461 Each result, and SEPARATOR, should be strings. Thus, using " " as SEPARATOR
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4462 results in spaces between the values returned by FUNCTION. SEQUENCE itself
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4463 may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4465 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4466 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4467 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4468 `mapconcat' will give up once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4470 arguments: (FUNCTION SEQUENCE SEPARATOR &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4471 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4472 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4473 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4474 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4475 Lisp_Object sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4476 Lisp_Object separator = args[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4477 Elemcount len = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4478 Lisp_Object *args0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4479 EMACS_INT i, nargs0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4480
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4481 args[2] = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4482 args[1] = separator;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4484 len = shortest_length_among_sequences (nargs - 2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4485
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4486 if (len == 0) return build_ascstring ("");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4487
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4488 nargs0 = len + len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4489 args0 = alloca_array (Lisp_Object, nargs0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4490
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4491 /* Special-case this, it's very common and doesn't require any
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4492 funcalls. Upside of doing it here, instead of cl-macs.el: no consing,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4493 apart from the final string, we allocate everything on the stack. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4494 if (EQ (function, Qidentity) && 3 == nargs && CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4495 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4496 for (i = 0; i < len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4497 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4498 args0[i] = XCAR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4499 sequence = XCDR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4500 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4501 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4502 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4503 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4504 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4505 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4506
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4507 for (i = len - 1; i >= 0; i--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4508 args0[i + i] = args0[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4509
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4510 for (i = 1; i < nargs0; i += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4511 args0[i] = separator;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4512
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4513 return Fconcat (nargs0, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4514 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4515
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4516 DEFUN ("mapcar", FmapcarX, 2, MANY, 0, /
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4517 Call FUNCTION on each element of SEQUENCE; return a list of the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4518 The result is a list of the same length as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4519 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4520
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4521 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4522 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4523 from each sequence will be used each time FUNCTION is called, and `mapcar'
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4524 stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4525
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4526 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4527 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4528 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4529 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4530 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4531 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4532 Lisp_Object *args0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4533
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4534 args0 = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4535 mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4537 return Flist ((int) len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4538 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4539
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4540 DEFUN ("mapvector", Fmapvector, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4541 Call FUNCTION on each element of SEQUENCE; return a vector of the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4542 The result is a vector of the same length as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4543 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4545 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4546 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4547 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4548 `mapvector' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4549
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4550 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4551 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4552 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4553 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4554 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4555 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4556 Lisp_Object result = make_vector (len, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4558 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4559 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4560 /* Don't pass result as the lisp_object argument, we want mapcarX to protect
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4561 a single list argument's elements from being garbage-collected. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4562 mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4563 Qmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4564 RETURN_UNGCPRO (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4565 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4566
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4567 DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4568 Call FUNCTION on each element of SEQUENCE; chain the results together.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4569
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4570 FUNCTION must normally return a list; the results will be concatenated
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4571 together using `nconc'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4572
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4573 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4574 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4575 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4576 `mapcan' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4577
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4578 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4579 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4580 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4581 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4582 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4583 Lisp_Object function = args[0], *result = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4584
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4585 mapcarX (len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4586
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4587 /* #'nconc GCPROs its args in case of signals and error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4588 return Fnconc (len, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4589 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4590
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4591 DEFUN ("mapc", Fmapc, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4592 Call FUNCTION on each element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4593
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4594 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4595 This function is like `mapcar' but does not accumulate the results,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4596 which is more efficient if you do not use the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4597
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4598 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4599 there are SEQUENCES, plus one for the elements from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4600 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4601 `mapc' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4602
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4603 Return SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4604
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4605 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4606 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4607 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4609 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4610 Lisp_Object sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4611 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4612 /* We need to GCPRO sequence, because mapcarX will modify the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4613 elements of the args array handed to it, and this may involve
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4614 elements of sequence getting garbage collected. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4615 GCPRO1 (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4616 mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4617 RETURN_UNGCPRO (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4618 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4619
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4620 DEFUN ("map", Fmap, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4621 Map FUNCTION across one or more sequences, returning a sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4622
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4623 TYPE is the sequence type to return, FUNCTION is the function, SEQUENCE is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4624 the first argument sequence, SEQUENCES are the other argument sequences.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4625
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4626 FUNCTION will be called with (1+ (length SEQUENCES)) arguments, and must be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4627 capable of accepting this number of arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4628
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4629 Certain TYPEs are recognised internally by `map', but others are not, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4630 `coerce' may throw an error on an attempt to convert to a TYPE it does not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4631 understand. A null TYPE means do not accumulate any values.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4632
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4633 arguments: (TYPE FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4634 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4635 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4636 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4637 Lisp_Object type = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4638 Lisp_Object function = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4639 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4640 Lisp_Object *args0 = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4641 Elemcount len = shortest_length_among_sequences (nargs - 2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4642 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4643
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4644 if (!NILP (type))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4645 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4646 args0 = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4647 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4648
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4649 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4651 if (EQ (type, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4653 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4655
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4656 if (EQ (type, Qvector) \|\| EQ (type, Qarray))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4657 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4658 result = Fvector (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4659 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4660 else if (EQ (type, Qstring))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4661 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4662 result = Fstring (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4663 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4664 else if (EQ (type, Qlist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4666 result = Flist (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4667 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4668 else if (EQ (type, Qbit_vector))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4669 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4670 result = Fbit_vector (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4671 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4672 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4673 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4674 result = Flist (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4675 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4676 result = call2 (Qcoerce, result, type);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4677 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4678 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4679
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4680 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4681 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4682
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4683 DEFUN ("map-into", Fmap_into, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4684 Modify RESULT-SEQUENCE using the return values of FUNCTION on SEQUENCES.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4685
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4686 RESULT-SEQUENCE and SEQUENCES can be lists or arrays.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4687
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4688 FUNCTION must accept at least as many arguments as there are SEQUENCES
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4689 \(possibly zero). If RESULT-SEQUENCE and the elements of SEQUENCES are not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4690 the same length, stop when the shortest is exhausted; any elements of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4691 RESULT-SEQUENCE beyond that are unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4692
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4693 Return RESULT-SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4695 arguments: (RESULT-SEQUENCE FUNCTION &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4696 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4697 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4698 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4699 Elemcount len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4700 Lisp_Object result_sequence = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4701 Lisp_Object function = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4702
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4703 args[0] = function;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4704 args[1] = result_sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4706 len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4707
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4708 mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4709 Qmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4711 return result_sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4713
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4714 DEFUN ("some", Fsome, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4715 Return true if PREDICATE gives non-nil for an element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4717 If so, return the value (possibly multiple) given by PREDICATE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4718
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4719 With optional SEQUENCES, call PREDICATE each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4720 there are SEQUENCES (plus one for the element from SEQUENCE).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4721
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4722 See also `find-if', which returns the corresponding element of SEQUENCE,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4723 rather than the value given by PREDICATE, and accepts bounding index
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4724 keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4725
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4726 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4727 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4728 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4729 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4730 Lisp_Object result = Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4731 result_ptr = STORE_VOID_IN_LISP ((void *) &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4732 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4733
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4734 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4735
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4736 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4738
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4739 DEFUN ("every", Fevery, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4740 Return true if PREDICATE is true of every element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4742 With optional SEQUENCES, call PREDICATE each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4743 there are SEQUENCES (plus one for the element from SEQUENCE).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4744
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4745 In contrast to `some', `every' never returns multiple values.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4747 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4748 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4749 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4750 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4751 Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4752 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4754 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4755
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4756 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4757 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4758
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4760 DEFUN ("reduce", Freduce, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4761 Combine the elements of SEQUENCE using FUNCTION, a binary operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4763 For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4764 SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4765 in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4767 Keywords supported: :start :end :from-end :initial-value :key
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4768 See `remove*' for the meaning of :start, :end, :from-end and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4769
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4770 :initial-value specifies an element (typically an identity element, such as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4771 0) that is conceptually prepended to the sequence (or appended, when
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4772 :from-end is given).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4774 If the sequence has one element, that element is returned directly.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4775 If the sequence has no elements, :initial-value is returned if given;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4776 otherwise, FUNCTION is called with no arguments, and its result returned.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4777
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4778 arguments: (FUNCTION SEQUENCE &key (START 0) (END (length SEQUENCE)) FROM-END INITIAL-VALUE (KEY #'identity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4779 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4780 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4781 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4782 Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4783 Elemcount starting, ending = MOST_POSITIVE_FIXNUM + 1, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4785 PARSE_KEYWORDS (Freduce, nargs, args, 5,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4786 (start, end, from_end, initial_value, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4787 (start = Qzero, initial_value = Qunbound));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4788
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4789 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4790 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4791 starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4792 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4793
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4794 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4795 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4796 #define CALL2(function, accum, item) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4797 IGNORE_MULTIPLE_VALUES (call2 (function, accum, item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4798
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4799 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4800 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4801 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4802 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4804
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4805 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4806 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4807 Lisp_Vector *vv = XVECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4808 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4810 check_sequence_range (sequence, start, end, make_fixnum (vv->size));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4812 ending = min (ending, vv->size);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4813
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4814 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4815
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4816 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4817 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4818 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4819 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4820 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4821 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4822 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4823 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4824 accum = KEY (key, vv->contents[starting]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4825 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4827 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4829 accum = KEY (key, vv->contents[ending - 1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4830 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4831 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4832 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4834 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4835 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4836 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4837 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4838 accum = CALL2 (function, accum, KEY (key, vv->contents[ii]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4839 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4840 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4841 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4842 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4843 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4845 accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4847 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4848
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4849 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4850 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4851 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4852 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4853 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4854 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4856 check_sequence_range (sequence, start, end, make_fixnum (bv->size));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4857 ending = min (ending, bv->size);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4859 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4860
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4861 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4862 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4863 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4864 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4865 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4866 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4867 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4868 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4869 accum = KEY (key, make_fixnum (bit_vector_bit (bv, starting)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4870 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4871 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4872 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4873 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4874 accum = KEY (key, make_fixnum (bit_vector_bit (bv, ending - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4875 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4876 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4877 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4878
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4879 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4881 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4882 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4883 accum = CALL2 (function, accum,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4884 KEY (key, make_fixnum (bit_vector_bit (bv, ii))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4885 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4886 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4887 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4888 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4889 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4890 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4891 accum = CALL2 (function, KEY (key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4892 make_fixnum (bit_vector_bit (bv,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4893 ii))),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4894 accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4895 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4896 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4897
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4898 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4899
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4900 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4901 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4902 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4903 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4905 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4906
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4907 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4908 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4909 Bytecount byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4910 Bytecount cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4911 const Ibyte *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4912 const Ibyte *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4913
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4914 for (ii = 0; ii != starting && cursor_offset < byte_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4915 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4916 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4917 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4918 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4919
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4920 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4921 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4922 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4923 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4924 else if (ending - starting && cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4925 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4926 accum = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4927 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4928 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4929 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4930
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4931 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4932 \|\| !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4933 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4934 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4935 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4937 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4938 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4939 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4940 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4941
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4942 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4944 accum = CALL2 (function, accum,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4945 KEY (key, make_char (itext_ichar (cursor))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4947 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4948 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4949
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4950 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4951 \|\| !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4952 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4953 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4954 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4955
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4956 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4957 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4958 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4959 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4961 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4963 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4965 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4966 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4967 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4968 Elemcount len = string_char_length (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4969 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4970 const Ibyte *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4972 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4973 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4974 starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4975
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4976 cursor = string_char_addr (sequence, ending - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4977 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4978
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4979 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4981 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4982 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4983 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4984 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4985 accum = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4986 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4987 if (ending > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4988 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4989 cursor = XSTRING_DATA (sequence) + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4990
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4991 if (!valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4992 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4993 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4994 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4995
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4996 DEC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4997 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4998 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	4999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5000
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5001 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5002 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5003 accum = CALL2 (function, KEY (key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5004 make_char (itext_ichar (cursor))),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5005 accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5006 if (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5007 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5008 cursor = XSTRING_DATA (sequence) + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5009
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5010 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5011 \|\| !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5012 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5013 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5014 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5016 DEC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5017 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5018 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5019 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5020 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5021
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5022 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5023 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5024 else if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5025 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5026 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5027 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5028 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5029
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5030 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5031
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5032 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5033 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5034 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5035 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5036 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5037 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5038 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5039 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5040 if (ii == starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5041 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5042 accum = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5043 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5044 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5045 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5046 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5047 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5048 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5049 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5050
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5051 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5052
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5053 if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5054 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5055 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5056 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5057 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5058 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5059 if (ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5060 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5061 accum = CALL2 (function, accum, KEY (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5062 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5063 else if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5064 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5065 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5066 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5067 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5068 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5070 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5071 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5072
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5073 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5074
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5075 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5076 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5077 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5078 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5080 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5081 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5082 Boolint need_accum = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5083 Lisp_Object *subsequence = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5084 Elemcount counting = 0, len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5085 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5086
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5087 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5088 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5089 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5090
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5091 /* :from-end with a list; make an alloca copy of the relevant list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5092 data, attempting to go backwards isn't worth the trouble. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5093 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5094 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5095 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5096 if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5097 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5098 subsequence = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5099 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5100 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5101 else if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5102 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5103 subsequence = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5104 need_accum = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5105 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5106
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5107 if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5108 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5109 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5111 if (counting >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5112 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5113 if (counting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5114 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5115 subsequence[ii++] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5116 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5117 else if (counting == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5119 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5120 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5121 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5122 ++counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5123 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5124 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5125
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5126 if (subsequence != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5127 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5128 len = ending - starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5129 /* If we could be sure that neither FUNCTION nor KEY modify
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5130 SEQUENCE, this wouldn't be necessary, since all the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5131 elements of SUBSEQUENCE would definitely always be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5132 reachable via SEQUENCE. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5133 GCPRO1 (subsequence[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5134 gcpro1.nvars = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5135 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5136
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5137 if (need_accum)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5138 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5139 accum = KEY (key, subsequence[len - 1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5140 --len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5142
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5143 for (ii = len; ii != 0;)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5144 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5145 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5146 accum = CALL2 (function, KEY (key, subsequence[ii]), accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5148
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5149 if (subsequence != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5150 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5151 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5153 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5155
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5156 /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5157 need to return the result of calling FUNCTION with zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5158 arguments. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5159 if (UNBOUNDP (accum))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5161 accum = IGNORE_MULTIPLE_VALUES (call0 (function));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5162 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5163
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5164 return accum;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5165 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5166
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5167 /* This function is the implementation of fill_string_range() and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5168 replace_string_range(); see the comments for those functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5169 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5170 replace_string_range_1 (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5171 const Ibyte source, const Ibyte source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5172 Lisp_Object item)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5173 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5174 Ibyte destp = XSTRING_DATA (dest), p = destp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5175 pend = p + XSTRING_LENGTH (dest), pcursor, item_buf[MAX_ICHAR_LEN];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5176 Bytecount prefix_bytecount, source_len = source_limit - source;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5177 Charcount ii = 0, ending, len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5178 Charcount starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5179 Elemcount delta;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5181 while (ii < starting && p < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5182 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5183 INC_IBYTEPTR (p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5184 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5185 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5186
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5187 pcursor = p;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5188
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5189 if (NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5190 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5191 while (pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5192 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5193 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5194 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5195 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5196
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5197 ending = len = ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5198 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5199 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5200 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5201 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5202 while (ii < ending && pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5203 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5204 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5205 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5206 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5207 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5208
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5209 if (pcursor == pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5210 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5211 /* We have the length, check it for our callers. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5212 check_sequence_range (dest, start, end, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5213 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5215 if (!(p == pend \|\| p == pcursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5216 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5217 prefix_bytecount = p - destp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5218
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5219 if (!NILP (item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5220 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5221 assert (source == NULL && source_limit == NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5222 source_len = set_itext_ichar (item_buf, XCHAR (item));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5223 delta = (source_len * (ending - starting)) - (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5224 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5225 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5226 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5227 assert (source != NULL && source_limit != NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5228 delta = source_len - (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5229 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5230
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5231 if (delta)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5232 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5233 resize_string (dest, prefix_bytecount, delta);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5234 destp = XSTRING_DATA (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5235 pcursor = destp + prefix_bytecount + (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5236 p = destp + prefix_bytecount;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5237 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5238
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5239 if (CHARP (item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5240 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5241 while (starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5242 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5243 memcpy (p, item_buf, source_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5244 p += source_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5245 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5246 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5247 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5248 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5249 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5250 while (starting < ending && source < source_limit)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5251 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5252 source_len = itext_copy_ichar (source, p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5253 p += source_len, source += source_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5254 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5255 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5256
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5257 init_string_ascii_begin (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5258 bump_string_modiff (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5259 sledgehammer_check_ascii_begin (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5262 return dest;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5263 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5264
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5265 DEFUN ("replace", Freplace, 2, MANY, 0, /*
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	5266 Replace the elements of SEQUENCE1 with the elements of SEQUENCE2.
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	5267
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	5268 SEQUENCE1 is destructively modified, and returned. Its length is not
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5269 changed.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5270
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	5271 Keywords :start1 and :end1 specify a subsequence of SEQUENCE1, and
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	5272 :start2 and :end2 a subsequence of SEQUENCE2. See `search' for more
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5273 information.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5274
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	5275 arguments: (SEQUENCE1 SEQUENCE2 &key (START1 0) (END1 (length SEQUENCE1)) (START2 0) (END2 (length SEQUENCE2)))
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5276 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5277 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5278 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5279 Lisp_Object sequence1 = args[0], sequence2 = args[1],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5280 result = sequence1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5281 Elemcount starting1, ending1 = MOST_POSITIVE_FIXNUM + 1, starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5282 Elemcount ending2 = MOST_POSITIVE_FIXNUM + 1, counting = 0, startcounting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5283 Boolint sequence1_listp, sequence2_listp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5284 overwriting = EQ (sequence1, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5285
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5286 PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5287 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5288
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5289 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5290 CHECK_LISP_WRITEABLE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5291
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5292 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5293
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5294 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5295 starting1 = BIGNUMP (start1) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5296 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5297 starting2 = BIGNUMP (start2) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5298
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5299 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5300 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5301 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5302 ending1 = BIGNUMP (end1) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5303 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5304
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5305 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5306 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5307 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5308 ending2 = BIGNUMP (end2) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5309 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5310
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5311 sequence1_listp = LISTP (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5312 sequence2_listp = LISTP (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5314 overwriting = overwriting && starting2 <= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5315
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5316 if (sequence1_listp && !ZEROP (start1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5317 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5318 sequence1 = Fnthcdr (start1, sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5319
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5320 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5321 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5322 check_sequence_range (args[0], start1, end1, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5323 /* Give up early here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5324 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5325 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5327 ending1 -= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5328 starting1 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5329 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5331 if (sequence2_listp && !ZEROP (start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5332 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5333 sequence2 = Fnthcdr (start2, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5334
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5335 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5336 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5337 check_sequence_range (args[1], start1, end1, Flength (args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5338 /* Nothing available to replace sequence1's contents. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5339 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5340 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5341
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5342 ending2 -= starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5343 starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5344 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5345
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5346 if (overwriting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5347 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5348 if (EQ (start1, start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5349 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5350 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5351 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5352
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5353 /* Our ranges may overlap. Save the data that might be overwritten. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5354
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5355 if (CONSP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5356 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5357 Elemcount len = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5358 Lisp_Object *subsequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5359 = alloca_array (Lisp_Object, min (ending2, len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5360 Elemcount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5362 LIST_LOOP_2 (elt, sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5363 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5364 if (counting == ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5365 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5366 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5367 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5369 subsequence[ii++] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5370 counting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5371 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5372
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5373 check_sequence_range (sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5374 /* The XFIXNUM (start2) is intentional here; we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5375 called #'length after doing (nthcdr
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5376 start2 sequence2). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5377 make_fixnum (XFIXNUM (start2) + len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5378 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5379 make_fixnum (XFIXNUM (start2) + len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5380
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5381 while (starting1 < ending1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5382 && starting2 < ending2 && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5384 XSETCAR (sequence1, subsequence[starting2]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5385 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5386 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5387 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5388 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5389 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5390 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5391 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5392 Ibyte *p = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5393 pend = p + XSTRING_LENGTH (sequence2), pcursor,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5394 *staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5395 Bytecount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5396
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5397 while (ii < starting2 && p < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5398 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5399 INC_IBYTEPTR (p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5400 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5401 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5402
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5403 pcursor = p;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5405 while (ii < ending2 && starting1 < ending1 && pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5406 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5407 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5408 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5409 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5410 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5411
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5412 if (pcursor == pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5413 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5414 check_sequence_range (sequence1, start1, end1, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5415 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5416 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5417 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5418 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5419 assert ((pcursor - p) > 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5420 staging = alloca_ibytes (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5421 memcpy (staging, p, pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5422 replace_string_range (result, start1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5423 make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5424 staging, staging + (pcursor - p));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5425 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5426 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5427 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5428 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5429 Elemcount seq_len = XFIXNUM (Flength (sequence2)), ii = 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5430 subseq_len = min (min (ending1 - starting1, seq_len - starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5431 min (ending2 - starting2, seq_len - starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5432 Lisp_Object *subsequence = alloca_array (Lisp_Object, subseq_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5433
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5434 check_sequence_range (sequence1, start1, end1, make_fixnum (seq_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5435 check_sequence_range (sequence2, start2, end2, make_fixnum (seq_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5436
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5437 while (starting2 < ending2 && ii < seq_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5438 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5439 subsequence[ii] = Faref (sequence2, make_fixnum (starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5440 ii++, starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5441 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5442
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5443 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5444
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5445 while (starting1 < ending1 && ii < seq_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5446 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5447 Faset (sequence1, make_fixnum (starting1), subsequence[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5448 ii++, starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5449 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5450 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5452 else if (sequence1_listp && sequence2_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5453 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5454 Lisp_Object sequence1_tortoise = sequence1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5455 sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5456 Elemcount shortest_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5458 counting = startcounting = min (ending1, ending2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5459
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5460 while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5461 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5462 XSETCAR (sequence1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5463 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5464 : Fcar (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5465 sequence1 = CONSP (sequence1) ? XCDR (sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5466 : Fcdr (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5467 sequence2 = CONSP (sequence2) ? XCDR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5468 : Fcdr (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5470 shortest_len++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5471
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5472 if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5473 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5474 if (counting & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5475 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5476 sequence1_tortoise = XCDR (sequence1_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5477 sequence2_tortoise = XCDR (sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5478 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5479
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5480 if (EQ (sequence1, sequence1_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5481 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5482 signal_circular_list_error (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5483 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5484
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5485 if (EQ (sequence2, sequence2_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5486 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5487 signal_circular_list_error (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5488 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5489 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5490 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5492 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5493 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5494 check_sequence_range (args[0], start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5495 make_fixnum (XFIXNUM (start1) + shortest_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5496 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5497 else if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5498 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5499 check_sequence_range (args[1], start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5500 make_fixnum (XFIXNUM (start2) + shortest_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5501 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5502 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5503 else if (sequence1_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5504 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5505 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5506 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5507 Ibyte *s2_data = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5508 *s2_end = s2_data + XSTRING_LENGTH (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5509 Elemcount char_count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5510 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5511
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5512 while (char_count < starting2 && s2_data < s2_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5513 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5514 INC_IBYTEPTR (s2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5515 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5518 while (starting1 < ending1 && starting2 < ending2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5519 && s2_data < s2_end && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5521 character = make_char (itext_ichar (s2_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5522 CONSP (sequence1) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5523 XSETCAR (sequence1, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5524 : Fsetcar (sequence1, character);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5525 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5526 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5527 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5528 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5529 INC_IBYTEPTR (s2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5530 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5532 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5533 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5534 check_sequence_range (sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5535 make_fixnum (XFIXNUM (start1) + starting1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5536 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5537
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5538 if (s2_data == s2_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5539 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5540 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5541 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5542 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5543 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5544 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5545 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5546 Elemcount len2 = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5547 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5548
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5549 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5550 while (starting2 < ending2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5551 && starting1 < ending1 && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5552 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5553 CHECK_CONS (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5554 XSETCAR (sequence1, Faref (sequence2, make_fixnum (starting2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5555 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5556 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5557 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5558 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5559
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5560 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5561 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5562 check_sequence_range (args[0], start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5563 make_fixnum (XFIXNUM (start1) + starting1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5564 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5565 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5566 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5567 else if (sequence2_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5569 if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5570 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5571 Elemcount ii = 0, count, len = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5572 Ibyte staging, cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5573 Lisp_Object obj;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5574
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5575 check_sequence_range (sequence1, start1, end1, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5576 ending1 = min (ending1, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5577 count = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5578 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5580 while (ii < count && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5581 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5582 obj = CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5583 : Fcar (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5584
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5585 CHECK_CHAR_COERCE_INT (obj);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5586 cursor += set_itext_ichar (cursor, XCHAR (obj));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5587 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5588 sequence2 = XCDR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5589 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5590
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5591 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5592 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5593 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5594 make_fixnum (XFIXNUM (start2) + ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5595 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5596
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5597 replace_string_range (result, start1, make_fixnum (XFIXNUM (start1) + ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5598 staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5599 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5600 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5601 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5602 Elemcount len = XFIXNUM (Flength (sequence1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5604 check_sequence_range (sequence1, start2, end1, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5605 ending1 = min (ending2, min (ending1, len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5606
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5607 while (starting1 < ending1 && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5609 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5610 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5611 : Fcar (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5612 sequence2 = XCDR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5613 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5614 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5615 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5616
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5617 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5618 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5619 check_sequence_range (args[1], start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5620 make_fixnum (XFIXNUM (start2) + starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5621 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5622 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5623 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5624 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5626 if (STRINGP (sequence1) && STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5628 Ibyte *p2 = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5629 p2end = p2 + XSTRING_LENGTH (sequence2), p2cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5630 Charcount ii = 0, len1 = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5631
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5632 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5633
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5634 while (ii < starting2 && p2 < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5635 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5636 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5637 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5638 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5639
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5640 p2cursor = p2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5641 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5642
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5643 while (ii < ending2 && starting1 < ending1 && p2cursor < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5644 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5645 INC_IBYTEPTR (p2cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5646 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5647 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5648 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5649
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5650 if (p2cursor == p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5651 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5652 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5653 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5654
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5655 /* This isn't great; any error message won't necessarily reflect
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5656 the END1 that was supplied to #'replace. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5657 replace_string_range (result, start1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5658 p2, p2cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5659 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5660 else if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5661 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5662 Ibyte staging, cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5663 Elemcount count, len1 = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5664 Elemcount len2 = XFIXNUM (Flength (sequence2)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5665 Lisp_Object obj;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5666
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5667 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5668 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5669
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5670 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5671 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5672 count = min (ending1 - starting1, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5673 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5674
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5675 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5676 while (ii < count)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5677 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5678 obj = Faref (sequence2, make_fixnum (starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5679
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5680 CHECK_CHAR_COERCE_INT (obj);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5681 cursor += set_itext_ichar (cursor, XCHAR (obj));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5682 starting2++, ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5683 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5684
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5685 replace_string_range (result, start1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5686 make_fixnum (XFIXNUM (start1) + count),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5687 staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5688 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5689 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5690 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5691 Ibyte *p2 = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5692 *p2end = p2 + XSTRING_LENGTH (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5693 Elemcount len1 = XFIXNUM (Flength (sequence1)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5695 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5696 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5697
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5698 while (ii < starting2 && p2 < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5699 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5700 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5701 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5703
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5704 while (p2 < p2end && starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5705 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5706 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5707 make_char (itext_ichar (p2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5708 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5709 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5710 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5711 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5713
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5714 if (p2 == p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5715 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5716 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5717 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5718 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5719 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5720 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5721 Elemcount len1 = XFIXNUM (Flength (sequence1)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5722 len2 = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5724 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5725 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5726
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5727 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5728 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5729
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5730 while (starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5731 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5732 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5733 Faref (sequence2, make_fixnum (starting2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5734 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5735 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5736 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5738 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5739
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5740 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5741 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5742
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5743 DEFUN ("nsubstitute", Fnsubstitute, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5744 Substitute NEW for OLD in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5746 This is a destructive function; it reuses the storage of SEQUENCE whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5747 possible. See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5749 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5750 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5751 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5752 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5753 Lisp_Object new_ = args[0], item = args[1], sequence = args[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5754 Lisp_Object object_, position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5755 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5756 Elemcount len, ii = 0, counting = MOST_POSITIVE_FIXNUM, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5757 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5758 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5760 PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5761 (test, if_, if_not, test_not, key, start, end, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5762 from_end), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5763
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5764 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5765 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5766 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5767
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5768 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5769 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5770 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5771 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5772 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5774 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5775 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5776 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5777 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5778 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5779 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5780 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5781 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5782 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5783 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5784 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5785 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5786 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5787 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5788
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5789 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5790 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5791 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5792 }
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5793
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5794 if (!NILP (from_end))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5795 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5796 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (Fnsubstitute))->min_args;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5797 ii < nargs; ii += 2)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5798 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5799 if (EQ (args[ii], Q_count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5800 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5801 args[ii + 1] = Qnil;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5802 break;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5803 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5804 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5805 ii = 0;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	5806 }
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5807 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5808
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5809 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5810 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5812 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5813 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5814 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5815 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5816 Lisp_Object present = count_with_tail (&object_, nargs - 1, args + 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5817 Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5819 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5820 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5821 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5822 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5823
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5824 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5825 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5827
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5829 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5831 if (!(ii < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5832 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5833 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5834 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5835
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5836 if (starting <= ii &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5837 check_test (test, key, item, elt) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5838 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5839 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5840 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5841 CHECK_LISP_WRITEABLE (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5842 XSETCAR (tail, new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5843 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5844 else if (!presenting && encountered >= counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5845 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5846 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5847 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5848
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5849 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5850 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5851 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5852 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5853
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5854 if ((ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5855 && encountered < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5856 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5857 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5858 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5859 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5860 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5861 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5862 Ibyte staging, new_bytes[MAX_ICHAR_LEN], staging_cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5863 Ibyte startp = XSTRING_DATA (sequence), cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5864 Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5865 Bytecount new_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5866 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5867
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5868 CHECK_CHAR_COERCE_INT (new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5869
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5870 new_len = set_itext_ichar (new_bytes, XCHAR (new_));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5871
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5872 /* Worst case scenario; new char is four octets long, all the old ones
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5873 were one octet long, all the old ones match. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5874 staging = alloca_ibytes (XSTRING_LENGTH (sequence) * new_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5875 staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5876
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5877 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5878 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5879 Lisp_Object present = count_with_tail (&character, nargs - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5880 args + 1, Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5881
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5882 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5883 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5884 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5885 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5886
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5887 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5888
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5889 /* If there are fewer items in the string than we have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5890 permission to change, we don't need to differentiate
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5891 between the :from-end nil and :from-end t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5892 cases. Otherwise, presenting is the number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5893 items we need to ignore before we start to change. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5894 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5895 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5897 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5898 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5899 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5900 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5901 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5902 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5903
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5904 if ((check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5905 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5906 && (presenting ? encountered++ >= presenting :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5907 encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5908 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5909 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5910 += itext_copy_ichar (new_bytes, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5911 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5912 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5913 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5914 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5915 += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5916 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5917
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5918 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5919 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5920
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5921 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5922 \|\| !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5923 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5924 mapping_interaction_error (Qnsubstitute, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5925 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5926 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5927 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5928 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5929 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5930 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5931
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5932 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5933 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5934 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5935 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5937 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5938 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5939 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5940 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5941
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5942 if (0 != encountered)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5944 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5945 replace_string_range (sequence, Qzero, make_fixnum (ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5946 staging, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5948 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5949 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5950 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5951 Elemcount positioning;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5952 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5954 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5955 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5956
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5957 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5958 test_not_unboundp, test, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5959 Qnil, Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5961 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5963 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5965
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5966 positioning = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5967 ending = min (len, ending);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5968
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5969 Faset (sequence, position0, new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5970 encountered = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5972 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5973 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5974 for (ii = positioning + 1; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5975 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5976 object_ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5977
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5978 if (check_test (test, key, item, object_) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5979 && encountered++ < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5981 Faset (sequence, make_fixnum (ii), new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5982 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5983 else if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5984 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5985 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5986 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5987 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5988 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5989 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5990 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5991 for (ii = positioning - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5992 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5993 object_ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5994
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5995 if (check_test (test, key, item, object_) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5996 && encountered++ < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5998 Faset (sequence, make_fixnum (ii), new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	5999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6000 else if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6001 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6002 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6003 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6005 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6007
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6008 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6009 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6010
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6011 DEFUN ("substitute", Fsubstitute, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6012 Substitute NEW for OLD in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6013
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6014 This is a non-destructive function; it makes a copy of SEQUENCE if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6015 to avoid corrupting the original SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6017 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6018
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6019 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) COUNT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6020 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6021 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6022 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6023 Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6024 Lisp_Object result = Qnil, result_tail = Qnil;
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6025 Lisp_Object object, position0, matched;
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6026 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6027 Elemcount ii = 0, counting = MOST_POSITIVE_FIXNUM, skipping = 0;
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6028 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6029 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6030 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6031
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6032 PARSE_KEYWORDS (Fsubstitute, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6033 (test, if_, if_not, test_not, key, start, end, count,
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6034 from_end), (start = Qzero));
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6036 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6037
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6038 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6039 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6041 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6042 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6043 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6044 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6045 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6046
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6047 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6048 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6049
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6050 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6051 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6052 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6053 test_not_unboundp, test, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6054 Qnil, Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6055
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6056 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6057 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6058 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6059 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6060 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6061 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6062 args[2] = Fcopy_sequence (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6063 return Fnsubstitute (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6064 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6065 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6066
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6067 if (!NILP (count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6068 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6069 CHECK_INTEGER (count);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6070 if (FIXNUMP (count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6071 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6072 counting = XFIXNUM (count);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6073 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6074 #ifdef HAVE_BIGNUM
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6075 else
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6076 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6077 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6078 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6079 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6080 #endif
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6081
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6082 if (counting <= 0)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6083 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6084 return sequence;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6085 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6086
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6087 /* Sigh, this is inelegant. Force count_with_tail () to ignore the count
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6088 keyword, so we get the actual number of matching elements, and can
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6089 start removing from the beginning for the from-end case. */
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6090 if (!NILP (from_end))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6091 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6092 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (Fsubstitute))->min_args;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6093 ii < nargs; ii += 2)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6094 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6095 if (EQ (args[ii], Q_count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6096 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6097 args[ii + 1] = Qnil;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6098 break;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6099 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6100 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6101 ii = 0;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6102 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6103 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6104
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6105 matched = count_with_tail (&tail, nargs - 1, args + 1, Qsubstitute);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6106
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6107 if (ZEROP (matched))
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6108 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6109 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6110 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6111
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6112 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6113 {
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6114 Elemcount matching = XFIXNUM (matched);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6115 if (matching > counting)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6116 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6117 /* skipping is the number of elements to be skipped before we start
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6118 substituting. It is for those cases where both :count and
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6119 :from-end are specified, and the number of elements present is
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6120 greater than that limit specified with :count. */
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6121 skipping = matching - counting;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6122 }
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6123 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6124
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6125 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6127 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6128 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6129 if (EQ (tail, tailing))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6130 {
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6131 /* No need to do check_test, we're sure that this element matches
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6132 because its cons is what count_with_tail returned as the
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6133 tail. */
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6134 if (skipping ? encountered >= skipping : encountered < counting)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6135 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6136 if (NILP (result))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6137 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6138 result = Fcons (new_, XCDR (tail));
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6139 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6140 else
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6141 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6142 XSETCDR (result_tail, Fcons (new_, XCDR (tail)));
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6143 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6144 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6145 else
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6146 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6147 XSETCDR (result_tail, tail);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6148 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6149
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6150 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6151 UNGCPRO;
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6152 return result;
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6153 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6154 else if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6155 (check_test (test, key, item, elt) == test_not_unboundp)
5852 e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute. Aidan Kehoe <kehoea@parhasard.net> parents: 5772 diff changeset	6156 && (skipping ? encountered++ >= skipping
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6157 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6158 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6159 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6161 result = result_tail = Fcons (new_, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6162 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6163 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6164 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6165 XSETCDR (result_tail, Fcons (new_, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6166 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6168 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6169 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6170 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6171 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6172 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6173 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6174 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6175 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6176 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6177 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6178
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6179 if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6180 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6181 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6182 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6183
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6184 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6185 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6186 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6187 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6188 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6189
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6190 if (ii < starting \|\| (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6191 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6192 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6193 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6194
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6195 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6196 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6197
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6198 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6199 subst (Lisp_Object new_, Lisp_Object old, Lisp_Object tree, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6200 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6201 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6202 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6203 stack_overflow ("Stack overflow in subst", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6204 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6206 if (EQ (tree, old))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6207 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6208 return new_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6209 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6210 else if (CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6211 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6212 Lisp_Object aa = subst (new_, old, XCAR (tree), depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6213 Lisp_Object dd = subst (new_, old, XCDR (tree), depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6215 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6216 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6217 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6218 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6219 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6220 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6221 return Fcons (aa, dd);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6222 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6223 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6224 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6225 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6226 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6227 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6228 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6229
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6230 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6231 sublis (Lisp_Object alist, Lisp_Object tree,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6232 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6233 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6234 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6235 Lisp_Object keyed = KEY (key, tree), aa, dd;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6236
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6237 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6238 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6239 stack_overflow ("Stack overflow in sublis", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6240 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6241
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6242 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6243 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6244 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6245 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6246 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6248 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6249 return XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6250 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6251 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6252 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6253 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6254
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6255 if (!CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6256 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6257 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6258 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6259
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6260 aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6261 depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6262 dd = sublis (alist, XCDR (tree), check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6263 depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6264
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6265 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6266 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6267 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6268 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6269
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6270 return Fcons (aa, dd);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6271 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6272
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6273 DEFUN ("sublis", Fsublis, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6274 Perform substitutions indicated by ALIST in TREE (non-destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6275 Return a copy of TREE with all matching elements replaced.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6276
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	6277 Each dotted pair in ALIST describes a map from an old value (the car) to be
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	6278 replaced by a new value (the cdr).
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	6279
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6280 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6281
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6282 arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6283 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6284 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6286 Lisp_Object alist = args[0], tree = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6287 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6288 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6289
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6290 PARSE_KEYWORDS (Fsublis, nargs, args, 5, (test, if_, test_not, if_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6291 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6293 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6294 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6295 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6296 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6298 get_check_match_function (&test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6299 /* sublis() is going to apply the key, don't ask
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6300 for a match function that will do it for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6301 us. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6302 Qidentity, &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6303
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6304 if (CONSP (alist) && NILP (XCDR (alist)) && CONSP (XCAR (alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6305 && EQ (key, Qidentity) && 1 == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6306 && (check_eq_nokey == check_test \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6307 (check_eql_nokey == check_test &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6308 !NON_FIXNUM_NUMBER_P (XCAR (XCAR (alist))))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6309 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6310 /* #'subst with #'eq is very cheap indeed; call it. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6311 return subst (XCDR (XCAR (alist)), XCAR (XCAR (alist)), tree, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6312 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6314 return sublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6316
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6317 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6318 nsublis (Lisp_Object alist, Lisp_Object tree,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6319 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6320 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6321 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6322 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6323 Lisp_Object tree_saved = tree, tortoise = tree, keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6324 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6325 int count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6327 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6328 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6329 stack_overflow ("Stack overflow in nsublis", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6330 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6331
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6332 GCPRO2 (tree_saved, keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6333
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6334 while (CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6335 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6336 Boolint replaced = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6337 keyed = KEY (key, XCAR (tree));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6338
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6339 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6340 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6341 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6342 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6343 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6344 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6345 CHECK_LISP_WRITEABLE (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6346 /* See comment in sublis() on using elt_cdr. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6347 XSETCAR (tree, XCDR (elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6348 replaced = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6349 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6350 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6351 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6352 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6353 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6354
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6355 if (!replaced)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6356 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6357 if (CONSP (XCAR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6359 nsublis (alist, XCAR (tree), check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6360 test, key, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6361 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6363
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6364 keyed = KEY (key, XCDR (tree));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6365 replaced = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6366
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6367 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6368 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6369 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6370 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6371 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6372 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6373 CHECK_LISP_WRITEABLE (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6374 XSETCDR (tree, XCDR (elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6375 tree = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6376 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6377 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6378 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6379 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6380 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6382 if (!NILP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6384 tree = XCDR (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6385 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6387 if (++count > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6388 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6389 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6390 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6391 tortoise = XCDR (tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6394 if (EQ (tortoise, tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6395 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6396 signal_circular_list_error (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6397 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6398 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6399 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6400
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6401 RETURN_UNGCPRO (tree_saved);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6402 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6403
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6404 DEFUN ("nsublis", Fnsublis, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6405 Perform substitutions indicated by ALIST in TREE (destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6406 Any matching element of TREE is changed via a call to `setcar'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6407
5752 70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	6408 Each dotted pair in ALIST describes a map from an old value (the car) to be
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	6409 replaced by a new value (the cdr).
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c Aidan Kehoe <kehoea@parhasard.net> parents: 5700 diff changeset	6410
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6411 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6412
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6413 arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6414 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6415 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6416 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6417 Lisp_Object alist = args[0], tree = args[1], tailed = Qnil, keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6418 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6419 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6420 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6421
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6422 PARSE_KEYWORDS (Fnsublis, nargs, args, 5, (test, if_, test_not, if_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6423 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6424
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6425 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6426 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6427 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6428 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6429
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6430 get_check_match_function (&test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6431 /* nsublis() is going to apply the key, don't ask
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6432 for a match function that will do it for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6433 us. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6434 Qidentity, &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6435
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6436 GCPRO2 (tailed, keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6437
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6438 keyed = KEY (key, tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6439
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6440 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6441 /* nsublis() won't attempt to replace a cons handed to it, do that
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6442 ourselves. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6443 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6444 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6445 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6446 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6447 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6448 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6449 return XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6450 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6452 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6453 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6455 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6456
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6457 return nsublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6458 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6459
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6460 DEFUN ("subst", Fsubst, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6461 Substitute NEW for OLD everywhere in TREE (non-destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6462
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6463 Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6465 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6467 arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6468 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6469 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6470 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6471 Lisp_Object result, alist = noseeum_cons (noseeum_cons (args[1], args[0]),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6472 Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6473 args[1] = alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6474 result = Fsublis (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6475 free_cons (XCAR (alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6476 free_cons (alist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6477
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6478 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6479 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6480
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6481 DEFUN ("nsubst", Fnsubst, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6482 Substitute NEW for OLD everywhere in TREE (destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6484 Any element of TREE which is `eql' to OLD is changed to NEW (via a call to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6485 `setcar').
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6486
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6487 See `member*' for the meaning of the keywords. The keyword
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6488 :descend-structures, not specified by Common Lisp, allows callers to specify
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6489 that non-cons objects (vectors and range tables, among others) should also
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6490 undergo substitution.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6492 arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT DESCEND-STRUCTURES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6493 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6494 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6495 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6496 Lisp_Object new_ = args[0], old = args[1], tree = args[2], result, alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6497 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6498 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6499
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6500 PARSE_KEYWORDS (Fnsubst, nargs, args, 6, (test, if_, test_not, if_not, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6501 descend_structures), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6502 if (!NILP (descend_structures))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6503 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6504 check_test = get_check_test_function (old, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6505 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6506
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6507 return nsubst_structures (new_, old, tree, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6508 test, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6509
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6511
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6512 alist = noseeum_cons (noseeum_cons (old, new_), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6513 args[1] = alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6514 result = Fnsublis (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6515 free_cons (XCAR (alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6516 free_cons (alist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6518 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6519 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6520
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6521 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6522 tree_equal (Lisp_Object tree1, Lisp_Object tree2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6523 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6524 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6525 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6526 Lisp_Object tortoise1 = tree1, tortoise2 = tree2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6527 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6528 int count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6529 Boolint result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6530
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6531 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6532 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6533 stack_overflow ("Stack overflow in tree-equal", tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6534 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6535
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6536 GCPRO2 (tree1, tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6537
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6538 while (CONSP (tree1) && CONSP (tree2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6539 && tree_equal (XCAR (tree1), XCAR (tree2), check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6540 test_not_unboundp, test, key, depth + 1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6541 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6542 tree1 = XCDR (tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6543 tree2 = XCDR (tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6545 if (++count > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6546 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6547 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6548 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6549 tortoise1 = XCDR (tortoise1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6550 tortoise2 = XCDR (tortoise2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6551 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6552
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6553 if (EQ (tortoise1, tree1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6554 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6555 signal_circular_list_error (tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6556 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6558 if (EQ (tortoise2, tree2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6559 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6560 signal_circular_list_error (tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6561 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6562 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6563 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6565 if (CONSP (tree1) \|\| CONSP (tree2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6566 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6567 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6568 return 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6569 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6570
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6571 result = check_test (test, key, tree1, tree2) == test_not_unboundp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6572 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6574 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6575 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6576
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6577 DEFUN ("tree-equal", Ftree_equal, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6578 Return t if TREE1 and TREE2 have `eql' leaves.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6580 Atoms are compared by `eql', unless another test is specified using
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6581 :test; cons cells are compared recursively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6582
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6583 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6584
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6585 arguments: (TREE1 TREE2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6586 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6587 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6589 Lisp_Object tree1 = args[0], tree2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6590 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6591 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6592
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6593 PARSE_KEYWORDS (Ftree_equal, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6594 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6595
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6596 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6597 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6598
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6599 return tree_equal (tree1, tree2, check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6600 0) ? Qt : Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6601 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6602
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6603 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6604 mismatch_from_end (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6605 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6606 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6607 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6608 Boolint UNUSED (return_sequence1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6609 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6610 Elemcount sequence1_len = XFIXNUM (Flength (sequence1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6611 Elemcount sequence2_len = XFIXNUM (Flength (sequence2)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6612 Elemcount starting1, ending1, starting2, ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6613 Lisp_Object sequence1_storage = NULL, sequence2_storage = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6614 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6615
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6616 check_sequence_range (sequence1, start1, end1, make_fixnum (sequence1_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6617 starting1 = XFIXNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6618 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6619 ending1 = min (ending1, sequence1_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6620
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6621 check_sequence_range (sequence2, start2, end2, make_fixnum (sequence2_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6622 starting2 = XFIXNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6623 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6624 ending2 = min (ending2, sequence2_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6625
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6626 if (LISTP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6628 Lisp_Object *saving;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6629 sequence1_storage = saving
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6630 = alloca_array (Lisp_Object, ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6631
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6633 EXTERNAL_LIST_LOOP_2 (elt, sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6634 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6635 if (starting1 <= ii && ii < ending1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6636 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6637 *saving++ = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6638 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6639 else if (ii == ending1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6640 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6641 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6643
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6644 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6645 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6646 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6647 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6648 else if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6649 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6650 const Ibyte *cursor = string_char_addr (sequence1, starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6651
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6652 STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence1_storage, ii,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6653 ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6654
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6655 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6656 else if (BIT_VECTORP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6657 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6658 Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6659 sequence1_storage = alloca_array (Lisp_Object, ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6660 for (ii = starting1; ii < ending1; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6661 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6662 sequence1_storage[ii - starting1]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6663 = make_fixnum (bit_vector_bit (vv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6664 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6666 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6667 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6668 sequence1_storage = XVECTOR_DATA (sequence1) + starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6669 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6670
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6671 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6672
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6673 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6674 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6675 Lisp_Object *saving;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6676 sequence2_storage = saving
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6677 = alloca_array (Lisp_Object, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6678
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6679 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6680 EXTERNAL_LIST_LOOP_2 (elt, sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6681 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6682 if (starting2 <= ii && ii < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6683 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6684 *saving++ = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6685 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6686 else if (ii == ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6687 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6688 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6689 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6690
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6691 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6692 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6693 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6694 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6695 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6696 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6697 const Ibyte *cursor = string_char_addr (sequence2, starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6698
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6699 STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence2_storage, ii,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6700 ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6701
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6703 else if (BIT_VECTORP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6704 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6705 Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6706 sequence2_storage = alloca_array (Lisp_Object, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6707 for (ii = starting2; ii < ending2; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6708 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6709 sequence2_storage[ii - starting2]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6710 = make_fixnum (bit_vector_bit (vv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6711 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6713 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6714 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6715 sequence2_storage = XVECTOR_DATA (sequence2) + starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6716 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6718 GCPRO2 (sequence1_storage[0], sequence2_storage[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6719 gcpro1.nvars = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6720 gcpro2.nvars = ending2 - starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6721
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6722 while (ending1 > starting1 && ending2 > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6723 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6724 --ending1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6725 --ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6726
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6727 if (check_match (test, key, sequence1_storage[ending1 - starting1],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6728 sequence2_storage[ending2 - starting2])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6729 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6730 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6731 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6732 return make_integer (ending1 + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6733 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6734 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6735
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6736 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6737
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6738 if (ending1 > starting1 \|\| ending2 > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6739 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6740 return make_integer (ending1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6741 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6742
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6743 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6746 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6747 mismatch_list_list (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6748 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6749 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6750 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6751 Boolint UNUSED (return_list_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6752 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6753 Lisp_Object sequence1_tortoise = sequence1, sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6754 Lisp_Object orig_sequence1 = sequence1, orig_sequence2 = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6755 Elemcount ending1 = MOST_POSITIVE_FIXNUM, ending2 = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6756 Elemcount starting1, starting2, counting, startcounting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6757 Elemcount shortest_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6758 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6760 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6761 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6763 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6764 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6765 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6766 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6767
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6768 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6769 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6770 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6771 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6772
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6773 if (!ZEROP (start1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6774 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6775 sequence1 = Fnthcdr (start1, sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6776
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6777 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6778 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6779 check_sequence_range (sequence1_tortoise, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6780 Flength (sequence1_tortoise));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6781 /* Give up early here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6782 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6783 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6785 ending1 -= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6786 starting1 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6787 sequence1_tortoise = sequence1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6788 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6789
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6790 if (!ZEROP (start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6791 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6792 sequence2 = Fnthcdr (start2, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6793
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6794 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6795 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6796 check_sequence_range (sequence2_tortoise, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6797 Flength (sequence2_tortoise));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6798 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6799 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6800
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6801 ending2 -= starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6802 starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6803 sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6804 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6805
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6806 GCPRO4 (sequence1, sequence2, sequence1_tortoise, sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6807
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6808 counting = startcounting = min (ending1, ending2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6810 while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6811 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6812 if (check_match (test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6813 CONSP (sequence1) ? XCAR (sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6814 : Fcar (sequence1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6815 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6816 : Fcar (sequence2) ) != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6817 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6818 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6819 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6820 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6821
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6822 sequence1 = CONSP (sequence1) ? XCDR (sequence1) : Fcdr (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6823 sequence2 = CONSP (sequence2) ? XCDR (sequence2) : Fcdr (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6824
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6825 shortest_len++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6826
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6827 if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6829 if (counting & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6831 sequence1_tortoise = XCDR (sequence1_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6832 sequence2_tortoise = XCDR (sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6833 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6834
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6835 if (EQ (sequence1, sequence1_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6836 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6837 signal_circular_list_error (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6838 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6839
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6840 if (EQ (sequence2, sequence2_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6841 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6842 signal_circular_list_error (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6843 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6844 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6845 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6846
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6847 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6848
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6849 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6850 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6851 Lisp_Object args[] = { start1, make_fixnum (shortest_len) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6852 check_sequence_range (orig_sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6853 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6854 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6856 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6857 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6858 Lisp_Object args[] = { start2, make_fixnum (shortest_len) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6859 check_sequence_range (orig_sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6860 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6861 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6862
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6863 if ((!NILP (end1) && shortest_len != ending1 - starting1) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6864 (!NILP (end2) && shortest_len != ending2 - starting2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6865 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6866 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6867 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6868
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6869 if ((NILP (end1) && CONSP (sequence1)) \|\| (NILP (end2) && CONSP (sequence2)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6870 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6871 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6872 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6873
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6874 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6875 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6876
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6877 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6878 mismatch_list_string (Lisp_Object list, Lisp_Object list_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6879 Lisp_Object list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6880 Lisp_Object string, Lisp_Object string_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6881 Lisp_Object string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6882 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6883 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6884 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6885 Boolint return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6886 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6887 Ibyte string_data = XSTRING_DATA (string), startp = string_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6888 Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6889 Elemcount char_count = 0, list_starting, list_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6890 Elemcount string_starting, string_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6891 Lisp_Object character, orig_list = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6892 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6893
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6894 list_ending = FIXNUMP (list_end) ? XFIXNUM (list_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6895 list_starting = FIXNUMP (list_start) ? XFIXNUM (list_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6897 string_ending = FIXNUMP (string_end) ? XFIXNUM (string_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6898 string_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6899 = FIXNUMP (string_start) ? XFIXNUM (string_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6900
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6901 while (char_count < string_starting && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6902 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6903 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6904 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6905 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6906 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6908 if (!ZEROP (list_start))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6909 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6910 list = Fnthcdr (list_start, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6911 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6912 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6913 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6914 Flength (orig_list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6915 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6916 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6917
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6918 list_ending -= list_starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6919 list_starting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6920 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6921
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6922 GCPRO1 (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6923
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6924 while (list_starting < list_ending && string_starting < string_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6925 && string_offset < string_len && !NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6926 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6927 character = make_char (itext_ichar (string_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6928
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6929 if (return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6930 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6931 if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6932 character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6933 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6934 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6935 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6936 return make_integer (XFIXNUM (list_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6937 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6938 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6939 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6941 if (check_match (test, key, character,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6942 CONSP (list) ? XCAR (list) : Fcar (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6943 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6944 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6945 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6946 return make_integer (char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6948 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6949
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6950 list = CONSP (list) ? XCDR (list) : Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6951
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6952 startp = XSTRING_DATA (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6953 string_data = startp + string_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6954 if (string_len != XSTRING_LENGTH (string)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6955 \|\| !valid_ibyteptr_p (string_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6956 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6957 mapping_interaction_error (Qmismatch, string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6958 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6959
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6960 list_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6961 string_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6962 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6963 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6964 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6965 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6966
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6967 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6968
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6969 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6970 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6971 Lisp_Object args[] = { list_start, make_fixnum (char_count) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6972 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6973 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6974 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6975
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6976 if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6977 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6978 check_sequence_range (string, string_start, string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6979 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6980 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6981
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6982 if ((NILP (string_end) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6983 string_offset < string_len : string_starting < string_ending) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6984 (NILP (list_end) ? !NILP (list) : list_starting < list_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6985 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6986 return make_integer (return_list_index ? XFIXNUM (list_start) + char_count :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6987 char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6988 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6989
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6990 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6992
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6993 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6994 mismatch_list_array (Lisp_Object list, Lisp_Object list_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6995 Lisp_Object list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6996 Lisp_Object array, Lisp_Object array_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6997 Lisp_Object array_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6998 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	6999 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7000 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7001 Boolint return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7002 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7003 Elemcount ii = 0, list_starting, list_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7004 Elemcount array_starting, array_ending, array_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7005 Lisp_Object orig_list = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7006 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7007
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7008 list_ending = FIXNUMP (list_end) ? XFIXNUM (list_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7009 list_starting = FIXNUMP (list_start) ? XFIXNUM (list_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7010
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7011 array_ending = FIXNUMP (array_end) ? XFIXNUM (array_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7012 array_starting = FIXNUMP (array_start) ? XFIXNUM (array_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7013 array_len = XFIXNUM (Flength (array));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7014
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7015 array_ending = min (array_ending, array_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7017 check_sequence_range (array, array_start, array_end, make_fixnum (array_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7018
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7019 if (!ZEROP (list_start))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7020 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7021 list = Fnthcdr (list_start, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7022 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7023 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7024 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7025 Flength (orig_list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7026 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7027 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7028
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7029 list_ending -= list_starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7030 list_starting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7031 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7032
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7033 GCPRO1 (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7034
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7035 while (list_starting < list_ending && array_starting < array_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7036 && !NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7037 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7038 if (return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7039 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7040 if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7041 Faref (array, make_fixnum (array_starting)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7042 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7043 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7044 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7045 return make_integer (XFIXNUM (list_start) + ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7046 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7047 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7048 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7049 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7050 if (check_match (test, key, Faref (array, make_fixnum (array_starting)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7051 CONSP (list) ? XCAR (list) : Fcar (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7052 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7053 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7054 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7055 return make_integer (array_starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7056 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7057 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7058
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7059 list = CONSP (list) ? XCDR (list) : Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7060 list_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7061 array_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7062 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7063 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7064
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7065 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7066
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7067 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7068 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7069 Lisp_Object args[] = { list_start, make_fixnum (ii) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7070 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7071 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7072 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7073
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7074 if (array_starting < array_ending \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7075 (NILP (list_end) ? !NILP (list) : list_starting < list_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7076 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7077 return make_integer (return_list_index ? XFIXNUM (list_start) + ii :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7078 array_starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7080
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7081 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7082 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7083
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7084 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7085 mismatch_string_array (Lisp_Object string, Lisp_Object string_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7086 Lisp_Object string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7087 Lisp_Object array, Lisp_Object array_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7088 Lisp_Object array_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7089 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7090 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7091 Boolint return_string_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7092 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7093 Ibyte string_data = XSTRING_DATA (string), startp = string_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7094 Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7095 Elemcount char_count = 0, array_starting, array_ending, array_length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7096 Elemcount string_starting, string_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7097 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7098
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7099 array_starting = FIXNUMP (array_start) ? XFIXNUM (array_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7100 array_ending = FIXNUMP (array_end) ? XFIXNUM (array_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7101 array_length = XFIXNUM (Flength (array));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7102 check_sequence_range (array, array_start, array_end, make_fixnum (array_length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7103 array_ending = min (array_ending, array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7105 string_ending = FIXNUMP (string_end) ? XFIXNUM (string_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7106 string_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7107 = FIXNUMP (string_start) ? XFIXNUM (string_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7108
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7109 while (char_count < string_starting && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7111 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7112 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7113 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7114 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7116 while (array_starting < array_ending && string_starting < string_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7117 && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7119 character = make_char (itext_ichar (string_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7120
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7121 if (return_string_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7122 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7123 if (check_match (test, key, character,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7124 Faref (array, make_fixnum (array_starting)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7125 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7127 return make_integer (char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7129 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7130 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7131 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7132 if (check_match (test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7133 Faref (array, make_fixnum (array_starting)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7134 character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7135 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7136 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7137 return make_integer (XFIXNUM (array_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7138 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7139 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7140
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7141 startp = XSTRING_DATA (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7142 string_data = startp + string_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7143 if (string_len != XSTRING_LENGTH (string)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7144 \|\| !valid_ibyteptr_p (string_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7145 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7146 mapping_interaction_error (Qmismatch, string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7148
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7149 array_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7150 string_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7151 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7152 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7153 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7155
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7156 if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7158 check_sequence_range (string, string_start, string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7159 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7160 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7161
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7162 if ((NILP (string_end) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7163 string_offset < string_len : string_starting < string_ending) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7164 (NILP (array_end) ? !NILP (array) : array_starting < array_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7165 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7166 return make_integer (return_string_index ? char_count :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7167 XFIXNUM (array_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7168 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7169
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7170 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7171 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7172
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7173 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7174 mismatch_string_string (Lisp_Object string1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7175 Lisp_Object string1_start, Lisp_Object string1_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7176 Lisp_Object string2, Lisp_Object string2_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7177 Lisp_Object string2_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7178 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7179 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7180 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7181 Boolint UNUSED (return_string1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7182 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7183 Ibyte string1_data = XSTRING_DATA (string1), startp1 = string1_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7184 Bytecount string1_offset = 0, string1_len = XSTRING_LENGTH (string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7185 Ibyte string2_data = XSTRING_DATA (string2), startp2 = string2_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7186 Bytecount string2_offset = 0, string2_len = XSTRING_LENGTH (string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7187 Elemcount char_count1 = 0, string1_starting, string1_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7188 Elemcount char_count2 = 0, string2_starting, string2_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7189 Lisp_Object character1, character2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7190
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7191 string1_ending = FIXNUMP (string1_end) ? XFIXNUM (string1_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7192 string1_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7193 = FIXNUMP (string1_start) ? XFIXNUM (string1_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7194
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7195 string2_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7196 = FIXNUMP (string2_start) ? XFIXNUM (string2_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7197 string2_ending = FIXNUMP (string2_end) ? XFIXNUM (string2_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7199 while (char_count1 < string1_starting && string1_offset < string1_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7200 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7201 INC_IBYTEPTR (string1_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7202 string1_offset = string1_data - startp1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7203 char_count1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7204 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7206 while (char_count2 < string2_starting && string2_offset < string2_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7207 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7208 INC_IBYTEPTR (string2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7209 string2_offset = string2_data - startp2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7210 char_count2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7211 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7212
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7213 while (string2_starting < string2_ending && string1_starting < string1_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7214 && string1_offset < string1_len && string2_offset < string2_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7215 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7216 character1 = make_char (itext_ichar (string1_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7217 character2 = make_char (itext_ichar (string2_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7218
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7219 if (check_match (test, key, character1, character2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7220 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7221 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7222 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7223 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7224
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7225 startp1 = XSTRING_DATA (string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7226 string1_data = startp1 + string1_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7227 if (string1_len != XSTRING_LENGTH (string1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7228 \|\| !valid_ibyteptr_p (string1_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7229 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7230 mapping_interaction_error (Qmismatch, string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7231 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7232
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7233 startp2 = XSTRING_DATA (string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7234 string2_data = startp2 + string2_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7235 if (string2_len != XSTRING_LENGTH (string2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7236 \|\| !valid_ibyteptr_p (string2_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7237 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7238 mapping_interaction_error (Qmismatch, string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7239 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7240
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7241 string2_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7242 string1_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7243 char_count1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7244 char_count2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7245 INC_IBYTEPTR (string1_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7246 string1_offset = string1_data - startp1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7247 INC_IBYTEPTR (string2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7248 string2_offset = string2_data - startp2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7249 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7250
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7251 if (string1_data == XSTRING_DATA (string1) + XSTRING_LENGTH (string1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7252 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7253 check_sequence_range (string1, string1_start, string1_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7254 make_fixnum (char_count1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7255 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7256
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7257 if (string2_data == XSTRING_DATA (string2) + XSTRING_LENGTH (string2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7258 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7259 check_sequence_range (string2, string2_start, string2_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7260 make_fixnum (char_count2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7261 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7262
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7263 if ((!NILP (string1_end) && string1_starting < string1_ending) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7264 (!NILP (string2_end) && string2_starting < string2_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7266 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7267 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7269 if ((NILP (string1_end) && string1_data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7270 < (XSTRING_DATA (string1) + XSTRING_LENGTH (string1))) \|\|
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7271 (NILP (string2_end) && string2_data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7272 < (XSTRING_DATA (string2) + XSTRING_LENGTH (string2))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7273 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7274 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7275 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7276
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7277 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7278 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7279
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7280 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7281 mismatch_array_array (Lisp_Object array1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7282 Lisp_Object array2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7283 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7284 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7285 Boolint UNUSED (return_array1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7286 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7287 Elemcount len1 = XFIXNUM (Flength (array1)), len2 = XFIXNUM (Flength (array2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7288 Elemcount ending1 = MOST_POSITIVE_FIXNUM, ending2 = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7289 Elemcount starting1, starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7290
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7291 check_sequence_range (array1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7292 check_sequence_range (array2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7293
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7294 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7295 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7296
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7297 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7298 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7299 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7300 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7301
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7302 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7303 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7304 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7305 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7306
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7307 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7308 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7309
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7310 while (starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7311 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7312 if (check_match (test, key, Faref (array1, make_fixnum (starting1)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7313 Faref (array2, make_fixnum (starting2)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7314 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7315 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7316 return make_integer (starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7317 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7318 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7319 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7320 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7321
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7322 if (starting1 < ending1 \|\| starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7323 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7324 return make_integer (starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7325 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7327 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7328 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7329
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7330 typedef Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7331 (*mismatch_func_t) (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7332 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7333 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7334 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7335 Boolint return_list_index);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7336
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7337 static mismatch_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7338 get_mismatch_func (Lisp_Object sequence1, Lisp_Object sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7339 Lisp_Object from_end, Boolint *return_sequence1_index_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7340 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7341 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7342 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7343
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7344 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7345 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7346 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7347 return mismatch_from_end;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7348 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7349
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7350 if (LISTP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7351 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7352 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7353 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7354 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7355 return mismatch_list_list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7356 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7357
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7358 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7359 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7360 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7361 return mismatch_list_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7363
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7364 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7365 return mismatch_list_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7366 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7367
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7368 if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7369 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7370 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7371 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7372 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7373 return mismatch_string_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7374 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7376 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7377 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7378 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7379 return mismatch_list_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7380 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7382 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7383 return mismatch_string_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7384 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7386 if (ARRAYP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7387 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7388 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7389 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7390 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7391 return mismatch_string_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7394 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7395 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7396 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7397 return mismatch_list_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7398 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7399
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7400 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7401 return mismatch_array_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7402 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7403
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7404 RETURN_NOT_REACHED (NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7405 return NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7406 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7407
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7408 DEFUN ("mismatch", Fmismatch, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7409 Compare SEQUENCE1 with SEQUENCE2, return index of first mismatching element.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7410
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7411 Return nil if the sequences match. If one sequence is a prefix of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7412 other, the return value indicates the end of the shorter sequence. A
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7413 non-nil return value always reflects an index into SEQUENCE1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7414
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7415 See `search' for the meaning of the keywords."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7417 arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7418 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7419 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7420 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7421 Lisp_Object sequence1 = args[0], sequence2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7422 Boolint test_not_unboundp = 1, return_first_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7423 check_test_func_t check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7424 mismatch_func_t mismatch = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7425
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7426 PARSE_KEYWORDS (Fmismatch, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7427 (test, key, from_end, start1, end1, start2, end2, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7428 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7429
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7430 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7431 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7432
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7433 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7434 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7435
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7436 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7437 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7438 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7439 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7441 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7443 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7444 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7445
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7446 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7447 &test_not_unboundp, NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7448 mismatch = get_mismatch_func (sequence1, sequence2, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7449 &return_first_index);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7450
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7451 if (return_first_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7452 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7453 return mismatch (sequence1, start1, end1, sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7454 check_match, test_not_unboundp, test, key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7455 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7456
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7457 return mismatch (sequence2, start2, end2, sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7458 check_match, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7461 DEFUN ("search", Fsearch, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7462 Search for SEQUENCE1 as a subsequence of SEQUENCE2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7463
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7464 Return the index of the leftmost element of the first match found; return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7465 nil if there are no matches.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7467 In this function, :start1 and :end1 specify a subsequence of SEQUENCE1, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7468 :start2 and :end2 specify a subsequence of SEQUENCE2. See `remove*' for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7469 details of the other keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7470
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7471 arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7472 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7473 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7474 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7475 Lisp_Object sequence1 = args[0], sequence2 = args[1], position0 = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7476 Boolint test_not_unboundp = 1, return_first = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7477 check_test_func_t check_test = NULL, check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7478 mismatch_func_t mismatch = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7479 Elemcount starting1 = 0, ending1 = 1 + MOST_POSITIVE_FIXNUM, starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7480 Elemcount ending2 = 1 + MOST_POSITIVE_FIXNUM, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7481 Elemcount length1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7482 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7483 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7484
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7485 PARSE_KEYWORDS (Fsearch, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7486 (test, key, from_end, start1, end1, start2, end2, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7487 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7488
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7489 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7490 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7491 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7492
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7493 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7494 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7495 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7496 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7498 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7499 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7500 Lisp_Object len1 = Flength (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7501
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7502 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7503 check_sequence_range (sequence1, start1, end1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7504 ending1 = min (XFIXNUM (end1), XFIXNUM (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7505 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7506 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7507 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7508 end1 = Flength (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7509 check_sequence_range (sequence1, start1, end1, end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7510 ending1 = XFIXNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7511 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7512
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7513 length1 = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7514
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7515 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7516 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7517 Lisp_Object len2 = Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7519 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7520 check_sequence_range (sequence2, start2, end2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7521 ending2 = min (XFIXNUM (end2), XFIXNUM (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7522 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7523 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7524 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7525 end2 = Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7526 check_sequence_range (sequence2, start2, end2, end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7527 ending2 = XFIXNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7528 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7529
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7530 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7531 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7532 mismatch = get_mismatch_func (sequence1, sequence2, from_end, &return_first);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7533
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7534 if (bytecode_arithcompare (start1, make_integer (ending1)) >= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7535 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7536 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7537 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7538 return start2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7539 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7541 if (NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7542 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7543 return Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7544 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7546 return end2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7547 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7548
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7549 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7550 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7551 Lisp_Object mismatch_start1 = Fadd1 (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7552 Lisp_Object first = KEY (key, Felt (sequence1, start1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7553 GCPRO2 (first, mismatch_start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7554
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7555 ii = starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7556 while (ii < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7557 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7558 position0 = position (&object, first, sequence2, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7559 test_not_unboundp, test, key, make_fixnum (ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7560 end2, Qnil, Qnil, Qsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7561 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7562 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7563 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7564 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7565 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7566
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7567 if (length1 + XFIXNUM (position0) <= ending2 &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7568 (return_first ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7569 NILP (mismatch (sequence1, mismatch_start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7570 sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7571 make_fixnum (1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7572 make_fixnum (length1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7573 check_match, test_not_unboundp, test, key, 1)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7574 NILP (mismatch (sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7575 make_fixnum (1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7576 make_fixnum (length1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7577 sequence1, mismatch_start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7578 check_match, test_not_unboundp, test, key, 0))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7580
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7581 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7582 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7583 return position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7584 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7585
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7586 ii = XFIXNUM (position0) + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7587 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7589 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7590 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7591 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7592 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7593 Lisp_Object mismatch_end1 = make_integer (ending1 - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7594 Lisp_Object last = KEY (key, Felt (sequence1, mismatch_end1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7595 GCPRO2 (last, mismatch_end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7596
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7597 ii = ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7598 while (ii > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7599 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7600 position0 = position (&object, last, sequence2, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7601 test_not_unboundp, test, key, start2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7602 make_fixnum (ii), Qt, Qnil, Qsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7604 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7605 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7606 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7607 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7608 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7609
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7610 if (XFIXNUM (position0) - length1 + 1 >= starting2 &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7611 (return_first ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7612 NILP (mismatch (sequence1, start1, mismatch_end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7613 sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7614 make_fixnum (XFIXNUM (position0) - length1 + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7615 make_fixnum (XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7616 check_match, test_not_unboundp, test, key, 1)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7617 NILP (mismatch (sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7618 make_fixnum (XFIXNUM (position0) - length1 + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7619 make_fixnum (XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7620 sequence1, start1, mismatch_end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7621 check_match, test_not_unboundp, test, key, 0))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7622 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7623 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7624 return make_fixnum (XFIXNUM (position0) - length1 + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7627 ii = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7628 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7629
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7630 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7631 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7632
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7633 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7634 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7635
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7636 /* These two functions do set operations, those that can be visualised with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7637 Venn diagrams. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7638 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7639 venn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7640 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7641 Lisp_Object liszt1 = args[0], liszt2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7642 Lisp_Object result = EQ (caller, Qsubsetp) ? Qt : Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7643 Lisp_Object keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7644 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7645 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7646 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7647
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7648 PARSE_KEYWORDS_8 (caller, nargs, args, 4, (test, key, test_not, stable),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7649 NULL, 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7651 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7652 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7653
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7654 CHECK_KEY_ARGUMENT (key);
5700 37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7655
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7656 /* #### Consider refactoring these tests into callers, and/or optimizing
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7657 tests. */
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7658 if (EQ (caller, Qsubsetp))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7659 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7660 if (NILP (liszt1))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7661 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7662 return Qt;
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7663 }
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7664 if (NILP (liszt2))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7665 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7666 return Qnil;
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7667 }
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell. Stephen J. Turnbull <stephen@xemacs.org> parents: 5607 diff changeset	7668 }
5607 1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7669
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7670 if (NILP (liszt1) && intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7671 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7672 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7673 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7674
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7675 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7676 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7677 return intersectionp ? Qnil : liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7678 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7679
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7680 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7681 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7682
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7683 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7684
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7686 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7687 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7688 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7689 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7690 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7691 test, key, 0, Qzero, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7692 != intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7693 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7694 if (EQ (Qsubsetp, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7695 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7696 result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7697 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7698 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7699 else if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7700 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7701 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7703 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7704 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7705 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7706 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7707 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7708 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7709 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7710 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7711 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7713 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7714 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7715 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7717 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7718
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7719 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7720 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7721
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7722 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7723 nvenn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7724 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7725 Lisp_Object liszt1 = args[0], liszt2 = args[1], tortoise_elt, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7726 Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, prev_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7727 Elemcount count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7728 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7729 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7730 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7731
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7732 PARSE_KEYWORDS_8 (caller, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7733 NULL, 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7734
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7735 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7736 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7737
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7738 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7739
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7740 if (NILP (liszt1) && intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7741 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7742 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7743 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7744
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7745 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7746 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7747 return intersectionp ? Qnil : liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7748 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7749
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7750 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7751 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7752
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7753 tortoise_elt = tail = liszt1, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7754
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7755 GCPRO4 (tail, keyed, liszt1, tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7756
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7757 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7758 (signal_malformed_list_error (liszt1), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7759 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7760 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7761 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7762 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7763 test, key, 0, Qzero, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7764 == intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7765 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7766 if (NILP (prev_tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7767 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7768 liszt1 = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7769 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7770 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7771 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7772 XSETCDR (prev_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7773 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7775 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7776 /* List is definitely not circular now! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7777 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7778 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7779 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7780 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7781 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7782 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7783 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7785 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7786
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7787 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7788 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7789 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7790 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7791
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7792 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7793 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7794 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7795 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7796 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7797
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7798 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7799
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7800 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7801 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7802
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7803 DEFUN ("intersection", Fintersection, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7804 Combine LIST1 and LIST2 using a set-intersection operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7805
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7806 The result list contains all items that appear in both LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7807 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7808 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7810 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7811 return the items in the order they appear in LIST1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7812
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7813 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7814
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7815 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7816 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7817 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7818 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7819 return venn (Qintersection, nargs, args, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7820 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7821
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7822 DEFUN ("nintersection", Fnintersection, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7823 Combine LIST1 and LIST2 using a set-intersection operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7824
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7825 The result list contains all items that appear in both LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7826 This is a destructive function; it reuses the storage of LIST1 whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7827 possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7828
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7829 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7831 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7832 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7833 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7834 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7835 return nvenn (Qnintersection, nargs, args, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7837
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7838 DEFUN ("subsetp", Fsubsetp, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7839 Return non-nil if every element of LIST1 also appears in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7840
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7841 See `union' for the meaning of the keyword arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7842
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7843 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7844 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7845 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7846 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7847 return venn (Qsubsetp, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7848 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7849
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7850 DEFUN ("set-difference", Fset_difference, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7851 Combine LIST1 and LIST2 using a set-difference operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7852
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7853 The result list contains all items that appear in LIST1 but not LIST2. This
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7854 is a non-destructive function; it makes a copy of the data if necessary to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7855 avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7856
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7857 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7859 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7860 return the items in the order they appear in LIST1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7861
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7862 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7863 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7864 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7865 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7866 return venn (Qset_difference, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7867 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7868
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7869 DEFUN ("nset-difference", Fnset_difference, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7870 Combine LIST1 and LIST2 using a set-difference operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7871
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7872 The result list contains all items that appear in LIST1 but not LIST2. This
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7873 is a destructive function; it reuses the storage of LIST1 whenever possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7874
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7875 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7876
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7877 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7878 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7879 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7881 return nvenn (Qnset_difference, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7882 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7883
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7884 DEFUN ("nunion", Fnunion, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7885 Combine LIST1 and LIST2 using a set-union operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7886 The result list contains all items that appear in either LIST1 or LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7887
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7888 This is a destructive function, it reuses the storage of LIST1 whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7889 possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7890
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7891 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7892
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7893 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7894 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7895 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7896 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7897 args[0] = nvenn (Qnunion, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7898 return bytecode_nconc2 (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7899 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7900
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7901 DEFUN ("union", Funion, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7902 Combine LIST1 and LIST2 using a set-union operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7903 The result list contains all items that appear in either LIST1 or LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7904 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7905 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7906
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7907 The keywords :test and :test-not specify two-argument test and negated-test
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7908 predicates, respectively; :test defaults to `eql'. See `member*' for more
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7909 information.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7910
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7911 :key specifies a one-argument function that transforms elements of LIST1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7912 and LIST2 into \"comparison keys\" before the test predicate is applied.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7913 For example, if :key is #'car, then the car of elements from LIST1 is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7914 compared with the car of elements from LIST2. The :key function, however,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7915 does not affect the elements in the returned list, which are taken directly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7916 from the elements in LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7917
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7918 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7919 return the items of LIST1 in order, followed by the remaining items of LIST2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7920 in the order they occur in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7921
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7922 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7923 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7924 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7925 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7926 Lisp_Object liszt1 = args[0], liszt2 = args[1], ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7927 Lisp_Object keyed = Qnil, result, result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7928 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7929 check_test_func_t check_test = NULL, check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7930 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7931
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7932 PARSE_KEYWORDS (Funion, nargs, args, 4, (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7933
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7934 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7935 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7937 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7938
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7939 if (NILP (liszt1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7941 return liszt2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7942 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7944 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7945 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7946 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7948
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7949 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7950 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7951
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7952 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7954 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7955 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7956 result = liszt2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7957 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7958 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7959 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7960 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7961 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7962 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7963 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7964 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7965 /* The Lisp version of #'union used to check which list was
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7966 longer, and use that as the tail of the constructed
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7967 list. That fails when the order of arguments to TEST is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7968 specified, as is the case for these functions. We could
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7969 pass the reverse_check argument to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7970 list_position_cons_before, but that means any key argument
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7971 is called an awful lot more, so it's a space win but not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7972 a time win. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7973 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7974 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7975 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7976 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7977 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7978 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7979 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7981 result = result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7982
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7983 /* The standard `union' doesn't produce a "stable" union -- it
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7984 iterates over the second list instead of the first one, and returns
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7985 the values in backwards order. According to the CLTL2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7986 documentation, `union' is not required to preserve the ordering of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7987 elements in any fashion; providing the functionality for a stable
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7988 union is an XEmacs extension. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7989 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7990 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7991 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7992 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7993 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7994 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7995 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7996 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7998 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	7999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8000 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8001 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8002 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8003 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8005 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8007 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8008 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8009
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8010 result = NILP (result) ? liszt1 : nconc2 (Fcopy_list (liszt1), result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8013 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8014
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8015 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8016 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8017
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8018 DEFUN ("set-exclusive-or", Fset_exclusive_or, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8019 Combine LIST1 and LIST2 using a set-exclusive-or operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8020
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8021 The result list contains all items that appear in exactly one of LIST1, LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8022 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8023 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8025 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8026
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8027 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8028 return the items in the order they appear in LIST1, followed by the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8029 remaining items in the order they appear in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8030
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8031 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8032 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8033 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8034 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8035 Lisp_Object liszt1 = args[0], liszt2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8036 Lisp_Object result = Qnil, result_tail = Qnil, keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8037 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8038 check_test_func_t check_match = NULL, check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8039 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8041 PARSE_KEYWORDS (Fset_exclusive_or, nargs, args, 4,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8042 (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8043
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8044 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8045 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8046
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8047 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8048
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8049 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8050 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8051 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8052 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8053
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8054 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8055 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8056
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8057 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8058 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8059 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8060 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8061 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8062 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8063 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8064 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8065 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8066 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8067 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8068 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8070 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8071 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8072 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8073 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8074 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8075 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8076 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8077 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8078 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8080 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8081 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8082 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8083
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8084 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8085 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8086 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8087 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8088 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8089 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8090 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8091 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8092 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8093 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8094 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8095 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8096 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8097 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8098 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8099 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8101 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8102 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8104 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8105 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8106 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8107 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8108
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8109 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8110
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8111 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8112 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8113
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8114 DEFUN ("nset-exclusive-or", Fnset_exclusive_or, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8115 Combine LIST1 and LIST2 using a set-exclusive-or operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8116
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8117 The result list contains all items that appear in exactly one of LIST1 and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8118 LIST2. This is a destructive function; it reuses the storage of LIST1 and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8119 LIST2 whenever possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8120
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8121 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8122
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8123 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8124 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8125 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8127 Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8128 Lisp_Object result = Qnil, tortoise_elt = Qnil, keyed = Qnil, swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8129 Lisp_Object prev_tail = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8130 Elemcount count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8131 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8132 check_test_func_t check_match = NULL, check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8133 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8134
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8135 PARSE_KEYWORDS (Fnset_exclusive_or, nargs, args, 4,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8136 (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8137
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8138 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8139 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8140
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8141 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8142
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8143 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8144 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8145 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8146 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8147
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8148 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8149 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8150
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8151 tortoise_elt = tail = liszt1, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8152
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8153 GCPRO4 (tail, keyed, result, tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8154
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8155 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8156 (signal_malformed_list_error (liszt1), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8158 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8159 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8160 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8161 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8162 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8163 swap = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8164
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8165 if (NILP (prev_tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8166 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8167 liszt1 = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8168 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8169 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8170 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8171 XSETCDR (prev_tail, swap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8172 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8173
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8174 XSETCDR (tail, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8175 result = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8176 tail = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8177
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8178 /* List is definitely not circular now! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8179 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8180 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8181 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8182 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8183 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8184 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8185 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8186
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8187 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8188
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8189 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8190 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8191 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8192 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8193
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8194 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8195 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8196 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8197 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8198 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8199
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8200 tortoise_elt = tail = liszt2, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8202 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8203 (signal_malformed_list_error (liszt2), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8204 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8205 /* Need to leave the key calculation to list_position_cons_before(). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8206 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8207 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8208 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8209 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8210 swap = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8211 XSETCDR (tail, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8212 result = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8213 tail = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8214 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8215 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8216 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8217 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8218 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8219 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8220
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8221 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8222
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8223 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8224 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8225 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8226 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8227
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8228 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8229 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8230 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8231 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8232 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8234 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8235
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8236 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8237 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8238
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8239 void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8240 syms_of_sequence (void)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8241 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8242 DEFSYMBOL (Qstring_lessp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8243 DEFSYMBOL (Qmerge);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8244 DEFSYMBOL (Qfill);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8245 DEFSYMBOL (Qidentity);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8246 DEFSYMBOL (Qvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8247 DEFSYMBOL (Qarray);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8248 DEFSYMBOL (Qstring);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8249 DEFSYMBOL (Qlist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8250 DEFSYMBOL (Qbit_vector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8251 defsymbol (&QsortX, "sort*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8252 DEFSYMBOL (Qreduce);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8253 DEFSYMBOL (Qreplace);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8254 DEFSYMBOL (Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8255 DEFSYMBOL (Qfind);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8256 defsymbol (&QdeleteX, "delete*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8257 defsymbol (&QremoveX, "remove*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8258
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8259 DEFSYMBOL (Qmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8260 defsymbol (&QmapcarX, "mapcar*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8261 DEFSYMBOL (Qmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8262 DEFSYMBOL (Qmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8263 DEFSYMBOL (Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8264 DEFSYMBOL (Qmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8265 DEFSYMBOL (Qmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8266 DEFSYMBOL (Qsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8267 DEFSYMBOL (Qevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8268 DEFSYMBOL (Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8269 DEFSYMBOL (Qdelete_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8270 DEFSYMBOL (Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8271 DEFSYMBOL (Qmismatch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8272 DEFSYMBOL (Qintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8273 DEFSYMBOL (Qnintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8274 DEFSYMBOL (Qsubsetp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8275 DEFSYMBOL (Qcar_less_than_car);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8276 DEFSYMBOL (Qset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8277 DEFSYMBOL (Qnset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8278 DEFSYMBOL (Qnunion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8279
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8280 DEFKEYWORD (Q_from_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8281 DEFKEYWORD (Q_initial_value);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8282 DEFKEYWORD (Q_start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8283 DEFKEYWORD (Q_start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8284 DEFKEYWORD (Q_end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8285 DEFKEYWORD (Q_end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8286 defkeyword (&Q_if_, ":if");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8287 DEFKEYWORD (Q_if_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8288 DEFKEYWORD (Q_test_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8289 DEFKEYWORD (Q_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8290 DEFKEYWORD (Q_stable);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8291 DEFKEYWORD (Q_descend_structures);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8293 DEFSUBR (Flength);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8294 DEFSUBR (Fcount);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8295 DEFSUBR (Fsubseq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8296 DEFSUBR (Felt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8297 DEFSUBR (Fcopy_tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8298 DEFSUBR (Fmember);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8299 DEFSUBR (Fmemq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8300 DEFSUBR (FmemberX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8301 DEFSUBR (Fadjoin);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8302 DEFSUBR (Fassoc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8303 DEFSUBR (Fassq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8304 DEFSUBR (FassocX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8305 DEFSUBR (Frassoc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8306 DEFSUBR (Frassq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8307 DEFSUBR (FrassocX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8308 DEFSUBR (Fposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8309 DEFSUBR (Ffind);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8310 DEFSUBR (FdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8311 DEFSUBR (FremoveX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8312 DEFSUBR (Fdelete_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8313 DEFSUBR (Fremove_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8314 DEFSUBR (Fnreverse);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8315 DEFSUBR (Freverse);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8316 DEFSUBR (Fmerge);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8317 DEFSUBR (FsortX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8318 DEFSUBR (Ffill);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8319 DEFSUBR (Fmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8320 DEFSUBR (FmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8321 DEFSUBR (Fmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8322 DEFSUBR (Fmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8323 DEFSUBR (Fmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8324 Ffset (intern ("mapc-internal"), Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8325 Ffset (intern ("mapcar"), QmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8326 DEFSUBR (Fmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8327 DEFSUBR (Fmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8328 DEFSUBR (Fsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8329 DEFSUBR (Fevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8330 DEFSUBR (Freduce);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8331 DEFSUBR (Freplace);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8332 DEFSUBR (Fnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8333 DEFSUBR (Fsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8334 DEFSUBR (Fsublis);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8335 DEFSUBR (Fnsublis);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8336 DEFSUBR (Fsubst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8337 DEFSUBR (Fnsubst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8338 DEFSUBR (Ftree_equal);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8339 DEFSUBR (Fmismatch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8340 DEFSUBR (Fsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8341 DEFSUBR (Fintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8342 DEFSUBR (Fnintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8343 DEFSUBR (Fsubsetp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8344 DEFSUBR (Fset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8345 DEFSUBR (Fnset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8346 DEFSUBR (Fnunion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8347 DEFSUBR (Funion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8348 DEFSUBR (Fset_exclusive_or);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8349 DEFSUBR (Fnset_exclusive_or);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c. Aidan Kehoe <kehoea@parhasard.net> parents: diff changeset	8350 }

Mercurial > hg > xemacs-beta

annotate src/sequence.c @ 5887:6eca500211f4