annotate lisp/cl.el @ 4885:6772ce4d982b

Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums lisp/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Correct the semantics of #'member*, #'eql, #'assoc* in the presence of bignums; change the integerp byte code to fixnump semantics. * bytecomp.el (fixnump, integerp, byte-compile-integerp): Change the integerp byte code to fixnump; add a byte-compile method to integerp using fixnump and numberp and avoiding a funcall most of the time, since in the non-core contexts where integerp is used, it's mostly distinguishing between fixnums and things that are not numbers at all. * byte-optimize.el (side-effect-free-fns, byte-after-unbind-ops) (byte-compile-side-effect-and-error-free-ops): Replace the integerp bytecode with fixnump; add fixnump to the side-effect-free-fns. Add the other extended number type predicates to the list in passing. * obsolete.el (floatp-safe): Mark this as obsolete. * cl.el (eql): Go into more detail in the docstring here. Don't bother checking whether both arguments are numbers; one is enough, #'equal will fail correctly if they have distinct types. (subst): Replace a call to #'integerp (deciding whether to use #'memq or not) with one to #'fixnump. Delete most-positive-fixnum, most-negative-fixnum from this file; they're now always in C, so they can't be modified from Lisp. * cl-seq.el (member*, assoc*, rassoc*): Correct these functions in the presence of bignums. * cl-macs.el (cl-make-type-test): The type test for a fixnum is now fixnump. Ditch floatp-safe, use floatp instead. (eql): Correct this compiler macro in the presence of bignums. (assoc*): Correct this compiler macro in the presence of bignums. * simple.el (undo): Change #'integerp to #'fixnump here, since we use #'delq with the same value as ELT a few lines down. src/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Fix problems with #'eql, extended number types, and the hash table implementation; change the Bintegerp bytecode to fixnump semantics even on bignum builds, since #'integerp can have a fast implementation in terms of #'fixnump for most of its extant uses, but not vice-versa. * lisp.h: Always #include number.h; we want the macros provided in it, even if the various number types are not available. * number.h (NON_FIXNUM_NUMBER_P): New macro, giving 1 when its argument is of non-immediate number type. Equivalent to FLOATP if WITH_NUMBER_TYPES is not defined. * elhash.c (lisp_object_eql_equal, lisp_object_eql_hash): Use NON_FIXNUM_NUMBER_P in these functions, instead of FLOATP, giving more correct behaviour in the presence of the extended number types. * bytecode.c (Bfixnump, execute_optimized_program): Rename Bintegerp to Bfixnump; change its semantics to reflect the new name on builds with bignum support. * data.c (Ffixnump, Fintegerp, syms_of_data, vars_of_data): Always make #'fixnump available, even on non-BIGNUM builds; always implement #'integerp in this file, even on BIGNUM builds. Move most-positive-fixnum, most-negative-fixnum here from number.c, so they are Lisp constants even on builds without number types, and attempts to change or bind them error. Use the NUMBERP and INTEGERP macros even on builds without extended number types. * data.c (fixnum_char_or_marker_to_int): Rename this function from integer_char_or_marker_to_int, to better reflect the arguments it accepts. * number.c (Fevenp, Foddp, syms_of_number): Never provide #'integerp in this file. Remove #'oddp, #'evenp; their implementations are overridden by those in cl.el. * number.c (vars_of_number): most-positive-fixnum, most-negative-fixnum are no longer here. man/ChangeLog addition: 2010-01-23 Aidan Kehoe <kehoea@parhasard.net> Generally: be careful to say fixnum, not integer, when talking about fixed-precision integral types. I'm sure I've missed instances, both here and in the docstrings, but this is a decent start. * lispref/text.texi (Columns): Document where only fixnums, not integers generally, are accepted. (Registers): Remove some ancient char-int confoundance here. * lispref/strings.texi (Creating Strings, Creating Strings): Be more exact in describing where fixnums but not integers in general are accepted. (Creating Strings): Use a more contemporary example to illustrate how concat deals with lists including integers about #xFF. Delete some obsolete documentation on same. (Char Table Types): Document that only fixnums are accepted as values in syntax tables. * lispref/searching.texi (String Search, Search and Replace): Be exact in describing where fixnums but not integers in general are accepted. * lispref/range-tables.texi (Range Tables): Be exact in describing them; only fixnums are accepted to describe ranges. * lispref/os.texi (Killing XEmacs, User Identification) (Time of Day, Time Conversion): Be more exact about using fixnum where only fixed-precision integers are accepted. * lispref/objects.texi (Integer Type): Be more exact (and up-to-date) about the possible values for integers. Cross-reference to documentation of the bignum extension. (Equality Predicates): (Range Table Type): (Array Type): Use fixnum, not integer, to describe a fixed-precision integer. (Syntax Table Type): Correct some English syntax here. * lispref/numbers.texi (Numbers): Change the phrasing here to use fixnum to mean the fixed-precision integers normal in emacs. Document that our terminology deviates from that of Common Lisp, and that we're working on it. (Compatibility Issues): Reiterate the Common Lisp versus Emacs Lisp compatibility issues. (Comparison of Numbers, Arithmetic Operations): * lispref/commands.texi (Command Loop Info, Working With Events): * lispref/buffers.texi (Modification Time): Be more exact in describing where fixnums but not integers in general are accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Jan 2010 15:21:27 +0000
parents e29fcfd8df5f
children 8431b52e43b1
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 446
diff changeset
1 ;;; cl.el --- Common Lisp extensions for XEmacs Lisp
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Author: Dave Gillespie <daveg@synaptics.com>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Version: 2.02
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: extensions, dumped, lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
27 ;;; Synched up with: FSF 21.3.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; These are extensions to Emacs Lisp that provide a degree of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; Common Lisp compatibility, beyond what is already built-in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; in Emacs Lisp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; This package was written by Dave Gillespie; it is a complete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; Bug reports, comments, and suggestions are welcome!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; This file contains the portions of the Common Lisp extensions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; package which should always be present.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;;; Future notes:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; Once Emacs 19 becomes standard, many things in this package which are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; messy for reasons of compatibility can be greatly simplified. For now,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; I prefer to maintain one unified version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;;; Change Log:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; Version 2.02 (30 Jul 93):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;; * Added "cl-compat.el" file, extra compatibility with old package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; * Added `lexical-let' and `lexical-let*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; * Added `define-modify-macro', `callf', and `callf2'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; * Added `ignore-errors'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; * Merged `*gentemp-counter*' into `*gensym-counter*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; * Extended `subseq' to allow negative START and END like `substring'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;; * Added `concat', `vconcat' loop clauses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; * Cleaned up a number of compiler warnings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; Version 2.01 (7 Jul 93):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; * Added support for FSF version of Emacs 19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; * Added `add-hook' for Emacs 18 users.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; * Added `defsubst*' and `symbol-macrolet'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;; * Added `map', `concatenate', `reduce', `merge'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; * Added `revappend', `nreconc', `tailp', `tree-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; * Added `assert', `check-type', `typecase', `typep', and `deftype'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; * Added destructuring and `&environment' support to `defmacro*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; * Added destructuring to `loop', and added the following clauses:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; * Renamed `delete' to `delete*' and `remove' to `remove*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; * Completed support for all keywords in `remove*', `substitute', etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; * Added `most-positive-float' and company.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;; * Fixed hash tables to work with latest Lucid Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;; * Syntax for `warn' declarations has changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;; * Improved implementation of `random*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;; * Moved most sequence functions to a new file, cl-seq.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;; * Moved `eval-when' into cl-macs.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;; * Moved `pushnew' and `adjoin' to cl.el for most common cases.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 ;; * Moved `provide' forms down to ends of files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;; * Changed expansion of `pop' to something that compiles to better code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 ;; * Changed so that no patch is required for Emacs 19 byte compiler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;; * Made more things dependent on `optimize' declarations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 ;; * Added a partial implementation of struct print functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 ;; * Miscellaneous minor changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 ;; Version 2.00:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 ;; * First public release of this package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (symbol-value 'epoch::version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (string-lessp emacs-version "19")) 18)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ((string-match "XEmacs" emacs-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 'lucid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (t 19)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (defvar cl-optimize-speed 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (defvar cl-optimize-safety 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (defvar custom-print-functions nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 "This is a list of functions that format user objects for printing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Each function is called in turn with three arguments: the object, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 stream, and the print level (currently ignored). If it is able to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 print the object it returns true; otherwise it returns nil and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 printer proceeds to the next function on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 This variable is not used at present, but it is defined in hopes that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 a future Emacs interpreter will be able to use it.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 ;;; Predicates.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (defun eql (a b) ; See compiler macro in cl-macs.el
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
126 "Return t if the arguments are the same Lisp object, or numerically equal.
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
127
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
128 They must be of the same type; the difference between `eq' and `eql' is most
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
129 relevant when it comes to the non-fixnum number types. In this
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
130 implementation, fixnums of the same numeric value are always `eq', but this
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
131 is not true for other numeric types, among them floats, bignums and ratios,
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
132 if available.
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
133
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
134 See also `=' (which doesn't require that its arguments be of the same type,
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
135 but only accepts numeric arguments, characters and markers) and `equal'."
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
136 (or (eq a b) (and (numberp a) (equal a b))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 ;;; Generalized variables. These macros are defined here so that they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 ;;; can safely be used in .emacs files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (defmacro incf (place &optional x)
3343
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
142 "Increment PLACE by X (1 by default).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 PLACE may be a symbol, or any generalized variable allowed by `setf'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 The return value is the incremented value of PLACE."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (if (symbolp place)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (list 'setq place (if x (list '+ place x) (list '1+ place)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 ;; XEmacs byte-compiler optimizes (+ FOO 1) to (1+ FOO), so this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 ;; is OK.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (list 'callf '+ place (or x 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (defmacro decf (place &optional x)
3343
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
152 "Decrement PLACE by X (1 by default).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 PLACE may be a symbol, or any generalized variable allowed by `setf'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 The return value is the decremented value of PLACE."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (if (symbolp place)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (list 'setq place (if x (list '- place x) (list '1- place)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (list 'callf '- place (or x 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (defmacro pop (place)
3343
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
160 "Remove and return the head of the list stored in PLACE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 careful about evaluating each argument only once and in the right order.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 PLACE may be a symbol, or any generalized variable allowed by `setf'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (if (symbolp place)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 `(car (prog1 ,place (setq ,place (cdr ,place))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (cl-do-pop place)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3343
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
168 (defmacro push (newelt listname)
3355
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3343
diff changeset
169 "Add NEWELT at the beginning of the list stored in LISTNAME.
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3343
diff changeset
170 Analogous to (setf LISTNAME (cons NEWELT LISTNAME)), though more careful
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3343
diff changeset
171 about evaluating each argument only once and in the right order. LISTNAME
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3343
diff changeset
172 may be a symbol, or any generalized variable allowed by `setf'; that is, it
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3343
diff changeset
173 does not necessarily have to be a list, though `push' is most often used on
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3343
diff changeset
174 lists. "
3343
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
175 (if (symbolp listname) `(setq ,listname (cons ,newelt ,listname))
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
176 (list 'callf2 'cons newelt listname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3343
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
178 (defmacro pushnew (newelt listname &rest keys)
3355
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3343
diff changeset
179 "Add NEWELT at the beginning of LISTNAME, unless it's already in LISTNAME.
3343
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
180 Like (push NEWELT LISTNAME), except that the list is unmodified if NEWELT is
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
181 `eql' to an element already on the list.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 Keywords supported: :test :test-not :key"
3343
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
183 (if (symbolp listname) (list 'setq listname
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
184 (list* 'adjoin newelt listname keys))
29234c1a76c7 [xemacs-hg @ 2006-04-16 15:54:16 by aidan]
aidan
parents: 2509
diff changeset
185 (list* 'callf2 'adjoin newelt listname keys)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (defun cl-set-elt (seq n val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (defun cl-set-nthcdr (n list x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (defun cl-set-buffer-substring (start end val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (save-excursion (delete-region start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (goto-char start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (insert val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (defun cl-set-substring (str start end val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (if end (if (< end 0) (incf end (length str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (setq end (length str)))
2136
9d6ec778e1e8 [xemacs-hg @ 2004-06-17 03:08:28 by james]
james
parents: 2092
diff changeset
202 (if (< start 0) (incf start (length str)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (concat (and (> start 0) (substring str 0 start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 val
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (and (< end (length str)) (substring str end))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 ;;; Control structures.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 ;; The macros `when' and `unless' are so useful that we want them to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 ;; ALWAYS be available. So they've been moved from cl.el to eval.c.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 ;; Note: FSF Emacs moved them to subr.el in FSF 20.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
214 (defalias 'cl-map-extents 'map-extents)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 ;;; Blocks and exits.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
219 ;; This used to be #'identity, but that didn't preserve multiple values in
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
220 ;; interpreted code. #'and isn't great either, there's no error on too many
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
221 ;; arguments passed to it when interpreted. Fortunately most of the places
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
222 ;; where cl-block-wrapper is called are generated from old, established
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
223 ;; macros, so too many arguments resulting from human error is unlikely; and
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
224 ;; the byte compile handler in cl-macs.el warns if more than one arg is
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
225 ;; passed to it.
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
226 (defalias 'cl-block-wrapper 'and)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
227
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (defalias 'cl-block-throw 'throw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
230 ;;; XEmacs; multiple values are in eval.c and cl-macs.el.
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
231
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
232 ;;; We no longer support `multiple-value-apply', which was ill-conceived to
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
233 ;;; start with, is not specified by Common Lisp, and which nothing uses,
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
234 ;;; according to Google Code Search, as of Sat Mar 14 23:31:35 GMT 2009.
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
235
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3355
diff changeset
236 (make-obsolete 'multiple-value-apply 'multiple-value-call)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 ;;; Macros.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (defvar cl-macro-environment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 ;; XEmacs: we renamed the internal function to macroexpand-internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 ;; to avoid doc-file problems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand-internal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (defalias 'macroexpand 'cl-macroexpand)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (defun cl-macroexpand (cl-macro &optional cl-env)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 "Return result of expanding macros at top level of FORM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 If FORM is not a macro call, it is returned unchanged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 Otherwise, the macro is expanded and the expansion is considered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 in place of FORM. When a non-macro-call results, it is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
252 The second optional arg ENVIRONMENT specifies an environment of macro
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 definitions to shadow the loaded ones for use in file byte-compilation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (let ((cl-macro-environment cl-env))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (and (symbolp cl-macro)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (cdr (assq (symbol-name cl-macro) cl-env))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 cl-macro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 ;;; Declarations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (defvar cl-compiling-file nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (defun cl-compiling-file ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (or cl-compiling-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 ; (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 ; (equal (buffer-name (symbol-value 'outbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ; " *Compiler Output*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (and (boundp 'byte-compile-outbuffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (bufferp (symbol-value 'byte-compile-outbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (equal (buffer-name (symbol-value 'byte-compile-outbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 " *Compiler Output*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (defvar cl-proclaims-deferred nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (defun proclaim (spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (push spec cl-proclaims-deferred))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (defmacro declaim (&rest specs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 specs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 ;;; Symbols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (defun cl-random-time ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
2509
6a9afa282c8e [xemacs-hg @ 2005-01-26 09:53:28 by ben]
ben
parents: 2367
diff changeset
296 (if-fboundp 'coerce-number
6a9afa282c8e [xemacs-hg @ 2005-01-26 09:53:28 by ben]
ben
parents: 2367
diff changeset
297 (coerce-number v 'fixnum)
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 613
diff changeset
298 v)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
302 ;; XEmacs change: gensym and gentemp moved here from cl-macs.el
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
303 (defun gensym (&optional arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
304 "Generate a new uninterned symbol.
2071
0f60caa73962 [xemacs-hg @ 2004-05-11 11:33:08 by stephent]
stephent
parents: 1983
diff changeset
305 The name is made by appending a number to a prefix. If ARG is a string, it
0f60caa73962 [xemacs-hg @ 2004-05-11 11:33:08 by stephent]
stephent
parents: 1983
diff changeset
306 is the prefix, otherwise the prefix defaults to \"G\". If ARG is an integer,
0f60caa73962 [xemacs-hg @ 2004-05-11 11:33:08 by stephent]
stephent
parents: 1983
diff changeset
307 the internal counter is reset to that number before creating the name.
0f60caa73962 [xemacs-hg @ 2004-05-11 11:33:08 by stephent]
stephent
parents: 1983
diff changeset
308 There is no way to specify both using this function."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
309 (let ((prefix (if (stringp arg) arg "G"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
310 (num (if (integerp arg) arg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
311 (prog1 *gensym-counter*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
312 (setq *gensym-counter* (1+ *gensym-counter*))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
313 (make-symbol (format "%s%d" prefix num))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
314
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
315 (defun gentemp (&optional arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
316 "Generate a new interned symbol with a unique name.
2071
0f60caa73962 [xemacs-hg @ 2004-05-11 11:33:08 by stephent]
stephent
parents: 1983
diff changeset
317 The name is made by appending a number to ARG, default \"G\".
0f60caa73962 [xemacs-hg @ 2004-05-11 11:33:08 by stephent]
stephent
parents: 1983
diff changeset
318 If ARG is not a string, it is ignored."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
319 (let ((prefix (if (stringp arg) arg "G"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
320 name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
321 (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
322 (setq *gensym-counter* (1+ *gensym-counter*)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
323 (intern name)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 ;;; Numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
327 ;; XEmacs change: ditch floatp-safe.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
329 (defun plusp (number)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 "Return t if NUMBER is positive."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
331 (> number 0))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
332
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
333 (defun minusp (number)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
334 "Return t if NUMBER is negative."
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
335 (< number 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
337 (defun oddp (integer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 "Return t if INTEGER is odd."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
339 (eq (logand integer 1) 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
341 (defun evenp (integer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 "Return t if INTEGER is even."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
343 (eq (logand integer 1) 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
345 ;; XEmacs addition
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
346 (defalias 'cl-abs 'abs)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 ;;; The following are set by code in cl-extra.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (defconst most-positive-float nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 "The float closest in value to positive infinity.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (defconst most-negative-float nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 "The float closest in value to negative infinity.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (defconst least-positive-float nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 "The positive float closest in value to 0.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (defconst least-negative-float nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 "The negative float closest in value to 0.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (defconst least-positive-normalized-float nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (defconst least-negative-normalized-float nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (defconst float-epsilon nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (defconst float-negative-epsilon nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 ;;; Sequence functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (defalias 'copy-seq 'copy-sequence)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (defun mapcar* (cl-func cl-x &rest cl-rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 "Apply FUNCTION to each element of SEQ, and make a list of the results.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 If there are several SEQs, FUNCTION is called with that many arguments,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 and mapping stops as soon as the shortest list runs out. With just one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 SEQ, this is like `mapcar'. With several, it is like the Common Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 `mapcar' function extended to arbitrary sequence types."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (if cl-rest
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (cl-mapcar-many cl-func (cons cl-x cl-rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (let ((cl-res nil) (cl-y (car cl-rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (while (and cl-x cl-y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (nreverse cl-res)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (mapcar cl-func cl-x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
384 (defalias 'svref 'aref)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 ;;; List functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 ;; These functions are made known to the byte-compiler by cl-macs.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 ;; and turned into efficient car and cdr bytecodes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (defalias 'first 'car)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (defalias 'rest 'cdr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (defalias 'endp 'null)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
395 ;; XEmacs change: make it a real function
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (defun second (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 "Return the second element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (car (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (defun third (x)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
401 "Return the third element of the list X."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (car (cdr (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (defun fourth (x)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
405 "Return the fourth element of the list X."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (nth 3 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (defun fifth (x)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
409 "Return the fifth element of the list X."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (nth 4 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (defun sixth (x)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
413 "Return the sixth element of the list X."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (nth 5 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 (defun seventh (x)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
417 "Return the seventh element of the list X."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (nth 6 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (defun eighth (x)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
421 "Return the eighth element of the list X."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (nth 7 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (defun ninth (x)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
425 "Return the ninth element of the list X."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (nth 8 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (defun tenth (x)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
429 "Return the tenth element of the list X."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (nth 9 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
432 ;; XEmacs change: Emacs defines caar, cadr, cdar, and cddr in subr.el.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (defun caar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 "Return the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (car (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (defun cadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 "Return the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (car (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (defun cdar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 "Return the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (cdr (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (defun cddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 "Return the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (cdr (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (defun caaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 "Return the `car' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (car (car (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (defun caadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 "Return the `car' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (car (car (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (defun cadar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 "Return the `car' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (car (cdr (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (defun caddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 "Return the `car' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (car (cdr (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (defun cdaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 "Return the `cdr' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (cdr (car (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (defun cdadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 "Return the `cdr' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (cdr (car (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (defun cddar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 "Return the `cdr' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (cdr (cdr (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (defun cdddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 "Return the `cdr' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (cdr (cdr (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (defun caaaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 "Return the `car' of the `car' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (car (car (car (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (defun caaadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 "Return the `car' of the `car' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (car (car (car (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (defun caadar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 "Return the `car' of the `car' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (car (car (cdr (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (defun caaddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 (car (car (cdr (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (defun cadaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 "Return the `car' of the `cdr' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (car (cdr (car (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (defun cadadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 (car (cdr (car (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 (defun caddar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (car (cdr (cdr (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (defun cadddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (car (cdr (cdr (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (defun cdaaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 "Return the `cdr' of the `car' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (cdr (car (car (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (defun cdaadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (cdr (car (car (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 (defun cdadar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (cdr (car (cdr (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (defun cdaddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (cdr (car (cdr (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (defun cddaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (cdr (cdr (car (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (defun cddadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (cdr (cdr (car (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (defun cdddar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (cdr (cdr (cdr (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (defun cddddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (cdr (cdr (cdr (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 ;;; `last' is implemented as a C primitive, as of 1998-11
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
546 ;;(defun last* (x &optional n)
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
547 ;; "Returns the last link in the list LIST.
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
548 ;;With optional argument N, returns Nth-to-last link (default 1)."
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
549 ;; (if n
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
550 ;; (let ((m 0) (p x))
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
551 ;; (while (consp p) (incf m) (pop p))
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
552 ;; (if (<= n 0) p
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
553 ;; (if (< n m) (nthcdr (- m n) x) x)))
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
554 ;; (while (consp (cdr x)) (pop x))
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
555 ;; x))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 "Return a new list with specified args as elements, cons'd to last arg.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 `(cons A (cons B (cons C D)))'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (cond ((not rest) arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 ((not (cdr rest)) (cons arg (car rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (t (let* ((n (length rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (copy (copy-sequence rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (last (nthcdr (- n 2) copy)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (setcdr last (car (cdr last)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (cons arg copy)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (defun ldiff (list sublist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 "Return a copy of LIST with the tail SUBLIST removed."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (let ((res nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (while (and (consp list) (not (eq list sublist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (push (pop list) res))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (nreverse res)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 ;;; `copy-list' is implemented as a C primitive, as of 1998-11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 ;(defun copy-list (list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 ; "Return a copy of a list, which may be a dotted list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 ;The elements of the list are not copied, just the list structure itself."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 ; (if (consp list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 ; (let ((res nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 ; (while (consp list) (push (pop list) res))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ; (prog1 (nreverse res) (setcdr res list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ; (car list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 (defun cl-maclisp-member (item list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (while (and list (not (equal item (car list)))) (setq list (cdr list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (defalias 'cl-member 'memq) ; for compatibility with old CL package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (defalias 'cl-floor 'floor*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (defalias 'cl-ceiling 'ceiling*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (defalias 'cl-truncate 'truncate*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (defalias 'cl-round 'round*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (defalias 'cl-mod 'mod*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 "Return ITEM consed onto the front of LIST only if it's not already there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 Otherwise, return LIST unmodified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (cond ((or (equal cl-keys '(:test eq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (and (null cl-keys) (not (numberp cl-item))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 ((or (equal cl-keys '(:test equal)) (null cl-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (t (apply 'cl-adjoin cl-item cl-list cl-keys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (defun subst (cl-new cl-old cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 "Substitute NEW for OLD everywhere in TREE (non-destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 Keywords supported: :test :test-not :key"
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4783
diff changeset
613 (if (or cl-keys (and (numberp cl-old) (not (fixnump cl-old))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (cl-do-subst cl-new cl-old cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (defun cl-do-subst (cl-new cl-old cl-tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 (cond ((eq cl-tree cl-old) cl-new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 ((consp cl-tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (let ((a (cl-do-subst cl-new cl-old (car cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (d (cl-do-subst cl-new cl-old (cdr cl-tree))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 cl-tree (cons a d))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (t cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (defun acons (a b c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 "Return a new alist created by adding (KEY . VALUE) to ALIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (cons (cons a b) c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 ;;; Miscellaneous.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (define-error 'cl-assertion-failed "Assertion failed")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
638 ;; XEmacs change: omit the autoload rules; we handle those a different way
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 ;;; Define data for indentation and edebug.
4783
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4683
diff changeset
641 (mapc-internal
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 #'(lambda (entry)
4783
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4683
diff changeset
643 (mapc-internal
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 #'(lambda (func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (put func 'lisp-indent-function (nth 1 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (put func 'lisp-indent-hook (nth 1 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (or (get func 'edebug-form-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 (put func 'edebug-form-spec (nth 2 entry))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (car entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 '(((defun* defmacro*) defun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 ((function*) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 ((eval-when) 1 (sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 ((when unless) 1 (&rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 ((declare) nil (&rest sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 ((the) 1 (sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 ((block return-from) 1 (sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 ((return) nil (&optional form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (form &rest form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 ((dolist dotimes) 1 ((symbolp form &rest form) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 ((do-symbols) 1 ((symbolp form &optional form form) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 ((do-all-symbols) 1 ((symbolp form &optional form) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 ((psetq setf psetf) nil edebug-setq-form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 ((progv) 2 (&rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 ((flet labels macrolet) 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ((&rest (sexp sexp &rest form)) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 ((symbol-macrolet lexical-let lexical-let*) 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 ((&rest &or symbolp (symbolp form)) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 ((multiple-value-bind) 2 ((&rest symbolp) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 ((multiple-value-setq) 1 ((&rest symbolp) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 ((letf letf*) 1 ((&rest (&rest form)) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 ((callf destructuring-bind) 2 (sexp form &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 ((callf2) 3 (sexp form form &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 ((loop) defun (&rest &or symbolp form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 ((ignore-errors) 0 (&rest form))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 ;;; This goes here so that cl-macs can find it if it loads right now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (provide 'cl-19) ; usage: (require 'cl-19 "cl")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 ;;; Things to do after byte-compiler is loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 ;;; As a side effect, we cause cl-macs to be loaded when compiling, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 ;;; that the compiler-macros defined there will be present.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 (defvar cl-hacked-flag nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 (defun cl-hack-byte-compiler ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (progn
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
694 (setq cl-hacked-flag t) ; Do it first, to prevent recursion.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
695 (when (not (fboundp 'cl-compile-time-init))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
696 (load "cl-macs" nil t))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
697 (cl-compile-time-init)))) ; In cl-macs.el.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 ;;; Try it now in case the compiler has already been loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (cl-hack-byte-compiler)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701
4683
0cc9d22c3732 Be more reliable about loading cl-macs at byte-compile time, cl.el.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4677
diff changeset
702 ;;; Also make a hook in case compiler is loaded after this file.
0cc9d22c3732 Be more reliable about loading cl-macs at byte-compile time, cl.el.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4677
diff changeset
703 (add-hook 'bytecomp-load-hook 'cl-hack-byte-compiler)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 ;;; The following ensures that packages which expect the old-style cl.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 ;;; will be happy with this one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (provide 'cl)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (run-hooks 'cl-load-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 2136
diff changeset
712 ;;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 ;;; cl.el ends here