Improve the lexical scoping in #'block, #'return-from. lisp/ChangeLog addition: 2011-02-07 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: * bytecomp.el (byte-compile-initial-macro-environment): Shadow `block', `return-from' here, we implement them differently when byte-compiling. * bytecomp.el (byte-compile-active-blocks): New. * bytecomp.el (byte-compile-block-1): New. * bytecomp.el (byte-compile-return-from-1): New. * bytecomp.el (return-from-1): New. * bytecomp.el (block-1): New. These are two aliases that exist to have their own associated byte-compile functions, which functions implement `block' and `return-from'. * cl-extra.el (cl-macroexpand-all): Fix a bug here when macros in the environment have been compiled. * cl-macs.el (block): * cl-macs.el (return): * cl-macs.el (return-from): Be more careful about lexical scope in these macros. * cl.el: * cl.el ('cl-block-wrapper): Removed. * cl.el ('cl-block-throw): Removed. These aren't needed in code generated by this XEmacs. They shouldn't be needed in code generated by XEmacs 21.4, but if it turns out the packages do need them, we can put them back. 2011-01-30 Mike Sperber <mike@xemacs.org> * font-lock.el (font-lock-fontify-pending-extents): Don't fail if `font-lock-mode' is unset, which can happen in the middle of `revert-buffer'. 2011-01-23 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete): * cl-macs.el (delq): * cl-macs.el (remove): * cl-macs.el (remq): Don't use the compiler macro if these functions were given the wrong number of arguments, as happens in lisp-tests.el. * cl-seq.el (remove, remq): Removed. I added these to subr.el, and forgot to remove them from here. 2011-01-22 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-setq, byte-compile-set): Remove kludge allowing keywords' values to be set, all the code that does that is gone. * cl-compat.el (elt-satisfies-test-p): * faces.el (set-face-parent): * faces.el (face-doc-string): * gtk-font-menu.el: * gtk-font-menu.el (gtk-reset-device-font-menus): * msw-font-menu.el: * msw-font-menu.el (mswindows-reset-device-font-menus): * package-get.el (package-get-installedp): * select.el (select-convert-from-image-data): * sound.el: * sound.el (load-sound-file): * x-font-menu.el (x-reset-device-font-menus-core): Don't quote keywords, they're self-quoting, and the win from backward-compatibility is sufficiently small now that the style problem overrides it. 2011-01-22 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (block, return-from): Require that NAME be a symbol in these macros, as always documented in the #'block docstring and as required by Common Lisp. * descr-text.el (unidata-initialize-unihan-database): Correct the use of non-symbols in #'block and #'return-from in this function. 2011-01-15 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (concatenate): Accept more complicated TYPEs in this function, handing the sequences over to #'coerce if we don't understand them here. * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its compiler macro is more useful than doing that. 2011-01-11 Aidan Kehoe <kehoea@parhasard.net> * subr.el (delete, delq, remove, remq): Move #'remove, #'remq here, they don't belong in cl-seq.el; move #'delete, #'delq here from fns.c, implement them in terms of #'delete*, allowing support for sequences generally. * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq here, now the latter's no longer dumped. * cl-macs.el (delete, delq): Add compiler macros transforming #'delete and #'delq to #'delete* calls. 2011-01-10 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): Correct a misplaced parenthesis here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se ! 2011-01-02 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): * list-mode.el (display-completion-list): These functions used to use cl-parsing-keywords; change them to use defun* instead, fixing the build. (Not sure what led to me not including this change in d1b17a33450b!) 2011-01-02 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (define-star-compiler-macros): Make sure the form has ITEM and LIST specified before attempting to change to calls with explicit tests; necessary for some tests in lisp-tests.el to compile correctly. (stable-union, stable-intersection): Add compiler macros for these functions, in the same way we do for most of the other functions in cl-seq.el. 2011-01-01 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (dolist, dotimes, do-symbols, macrolet) (symbol-macrolet): Define these macros with defmacro* instead of parsing the argument list by hand, for the sake of style and readability; use backquote where appropriate, instead of calling #'list and and friends, for the same reason. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * x-misc.el (device-x-display): Provide this function, documented in the Lispref for years, but not existing previously. Thank you Julian Bradfield, thank you Jeff Mincy. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el: Move the heavy lifting from this file to C. Dump the cl-parsing-keywords macro, but don't use defun* for the functions we define that do take keywords, dynamic scope lossage makes that not practical. * subr.el (sort, fillarray): Move these aliases here. (map-plist): #'nsublis is now built-in, but at this point #'eql isn't necessarily available as a test; use #'eq. * obsolete.el (cl-delete-duplicates): Make this available for old compiler macros and old code. (memql): Document that this is equivalent to #'member*, and worse. * cl.el (adjoin, subst): Removed. These are in C. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * simple.el (assoc-ignore-case): Remove a duplicate definition of this function (it's already in subr.el). * iso8859-1.el (char-width): On non-Mule, make this function equivalent to that produced by (constantly 1), but preserve its docstring. * subr.el (subst-char-in-string): Define this in terms of #'substitute, #'nsubstitute. (string-width): Define this using #'reduce and #'char-width. (char-width): Give this a simpler definition, it makes far more sense to check for mule at load time and redefine, as we do in iso8859-1.el. (store-substring): Implement this in terms of #'replace, now #'replace is cheap. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * update-elc.el (lisp-files-needed-for-byte-compilation) (lisp-files-needing-early-byte-compilation): cl-macs belongs in the former, not the latter, it is as fundamental as bytecomp.el. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl.el: Provde the Common Lisp program-error, type-error as error symbols. This doesn't nearly go far enough for anyone using the Common Lisp errors. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete-duplicates): If the form has an incorrect number of arguments, don't attempt a compiler macroexpansion. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (cl-safe-expr-p): Forms that start with the symbol lambda are also safe. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (= < > <= >=): For these functions' compiler macros, the optimisation is safe even if the first and the last arguments have side effects, since they're only used the once. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (inline-side-effect-free-compiler-macros): Unroll a loop here at macro-expansion time, so these compiler macros are compiled. Use #'eql instead of #'eq in a couple of places for better style. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (notany, notevery): Avoid some dynamic scope stupidity with local variable names in these functions, when they weren't prefixed with cl-; go into some more detail in the doc strings. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): #'remove, #'remq are free of side-effects. (side-effect-and-error-free-fns): Drop dot, dot-marker from the list. 2010-11-17 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (coerce): In the argument list, name the first argument OBJECT, not X; the former name was always used in the doc string and is clearer. Handle vector type specifications which include the length of the target sequence, error if there's a mismatch. * cl-macs.el (cl-make-type-test): Handle type specifications starting with the symbol 'eql. 2010-11-14 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (eql): Don't remove the byte-compile property of this symbol. That was necessary to override a bug in bytecomp.el where #'eql was confused with #'eq, which bug we no longer have. If neither expression is constant, don't attempt to handle the expression in this compiler macro, leave it to byte-compile-eql, which produces better code anyway. * bytecomp.el (eq): #'eql is not the function associated with the byte-eq byte code. (byte-compile-eql): Add an explicit compile method for this function, for cases where the cl-macs compiler macro hasn't reduced it to #'eq or #'equal. 2010-10-25 Aidan Kehoe <kehoea@parhasard.net> Add compiler macros and compilation sanity-checking for various functions that take keywords. * byte-optimize.el (side-effect-free-fns): #'symbol-value is side-effect free and not error free. * bytecomp.el (byte-compile-normal-call): Check keyword argument lists for sanity; store information about the positions where keyword arguments start using the new byte-compile-keyword-start property. * cl-macs.el (cl-const-expr-val): Take a new optional argument, cl-not-constant, defaulting to nil, in this function; return it if the expression is not constant. (cl-non-fixnum-number-p): Make this into a separate function, we want to pass it to #'every. (eql): Use it. (define-star-compiler-macros): Use the same code to generate the member*, assoc* and rassoc* compiler macros; special-case some code in #'add-to-list in subr.el. (remove, remq): Add compiler macros for these two functions, in preparation for #'remove being in C. (define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to (remove ... :if-not) at compile time, which will be a real win once the latter is in C. (define-substitute-if-compiler-macros) (define-subst-if-compiler-macros): Similarly for these functions. (delete-duplicates): Change this compiler macro to use #'plists-equal; if we don't have information about the type of SEQUENCE at compile time, don't bother attempting to inline the call, the function will be in C soon enough. (equalp): Remove an old commented-out compiler macro for this, if we want to see it it's in version control. (subst-char-in-string): Transform this to a call to nsubstitute or nsubstitute, if that is appropriate. * cl.el (ldiff): Don't call setf here, this makes for a load-time dependency problem in cl-macs.el 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * term/vt100.el: Refer to XEmacs, not GNU Emacs, in permissions. * term/bg-mouse.el: * term/sup-mouse.el: Put copyright notice in canonical "Copyright DATE AUTHOR" form. Refer to XEmacs, not GNU Emacs, in permissions. * site-load.el: Add permission boilerplate. * mule/canna-leim.el: * alist.el: Refer to XEmacs, not APEL/this program, in permissions. * mule/canna-leim.el: Remove my copyright, I've assigned it to the FSF. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * gtk.el: * gtk-widget-accessors.el: * gtk-package.el: * gtk-marshal.el: * gtk-compose.el: * gnome.el: Add copyright notice based on internal evidence. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * easymenu.el: Add reference to COPYING to permission notice. * gutter.el: * gutter-items.el: * menubar-items.el: Fix typo "Xmacs" in permissions notice. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * auto-save.el: * font.el: * fontconfig.el: * mule/kinsoku.el: Add "part of XEmacs" text to permission notice. 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): * cl-macs.el (remf, getf): * cl-extra.el (tailp, cl-set-getf, cl-do-remf): * cl.el (ldiff, endp): Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp; add circularity checking for the first two. #'cl-set-getf and #'cl-do-remf were Lisp implementations of #'plist-put and #'plist-remprop; change the names to aliases, changes the macros that use them to using #'plist-put and #'plist-remprop directly. 2010-10-12 Aidan Kehoe <kehoea@parhasard.net> * abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table): Create both these abbrev tables using the usual #'define-abbrev-table calls, rather than attempting to special-case them. * cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is being loaded interpreted. Previously other, later files would redundantly call (load "cl-macs") when interpreted, it's more reasonable to do it here, once. * cmdloop.el (read-quoted-char-radix): Use defcustom here, we don't have any dump-order dependencies that would prevent that. * custom.el (eval-when-compile): Don't load cl-macs when interpreted or when byte-compiling, rely on cl-extra.el in the former case and the appropriate entry in bytecomp-load-hook in the latter. Get rid of custom-declare-variable-list, we have no dump-time dependencies that would require it. * faces.el (eval-when-compile): Don't load cl-macs when interpreted or when byte-compiling. * packages.el: Remove some inaccurate comments. * post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not here, now the order of preloaded-file-list has been changed to make it available. * subr.el (custom-declare-variable-list): Remove. No need for it. Also remove a stub define-abbrev-table from this file, given the current order of preloaded-file-list there's no need for it. 2010-10-10 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are also constant. (byte-compile-initial-macro-environment): In #'the, if FORM is constant and does not match TYPE, warn at byte-compile time. 2010-10-10 Aidan Kehoe <kehoea@parhasard.net> * backquote.el (bq-vector-contents, bq-list*): Remove; the former is equivalent to (append VECTOR nil), the latter to (list* ...). (bq-process-2): Use (append VECTOR nil) instead of using #'bq-vector-contents to convert to a list. (bq-process-1): Now we use list* instead of bq-list * subr.el (list*): Moved from cl.el, since it is now required to be available the first time a backquoted form is encountered. * cl.el (list*): Move to subr.el. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * test-harness.el (Check-Message): Add an omitted comma here, thank you the buildbot. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * hash-table.el (hash-table-key-list, hash-table-value-list) (hash-table-key-value-alist, hash-table-key-value-plist): Remove some useless #'nreverse calls in these files; our hash tables have no order, it's not helpful to pretend they do. * behavior.el (read-behavior): Do the same in this file, in some code evidently copied from hash-table.el. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * info.el (Info-insert-dir): * format.el (format-deannotate-region): * files.el (cd, save-buffers-kill-emacs): Use #'some, #'every and related functions for applying boolean operations to lists, instead of rolling our own ones that cons and don't short-circuit. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-initial-macro-environment): * cl-macs.el (the): Rephrase the docstring, make its implementation when compiling files a little nicer. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * descr-text.el (unidata-initialize-unicodedata-database) (unidata-initialize-unihan-database, describe-char-unicode-data) (describe-char-unicode-data): Wrap calls to the database functions with (with-fboundp ...), avoiding byte compile warnings on builds without support for the database functions. (describe-char): (reduce #'max ...), not (apply #'max ...), no need to cons needlessly. (describe-char): Remove a redundant lambda wrapping #'extent-properties. (describe-char-unicode-data): Call #'nsubst when replacing "" with nil in the result of #'split-string, instead of consing inside mapcar. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * x-faces.el (x-available-font-sizes): * specifier.el (let-specifier): * package-ui.el (pui-add-required-packages): * msw-faces.el (mswindows-available-font-sizes): * modeline.el (modeline-minor-mode-menu): * minibuf.el (minibuf-directory-files): Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (= < > <= >=): When these functions are handed more than two arguments, and those arguments have no side effects, transform to a series of two argument calls, avoiding funcall in the byte-compiled code. * mule/mule-cmds.el (finish-set-language-environment): Take advantage of this change in a function called 256 times at startup. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-function-form, byte-compile-quote) (byte-compile-quote-form): Warn at compile time, and error at runtime, if a (quote ...) or a (function ...) form attempts to quote more than one object. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc (mapcar ...)) to (mapcan ...); warn about use of the first idiom. * update-elc.el (do-autoload-commands): * packages.el (packages-find-package-library-path): * frame.el (frame-list): * extents.el (extent-descendants): * etags.el (buffer-tag-table-files): * dumped-lisp.el (preloaded-file-list): * device.el (device-list): * bytecomp-runtime.el (proclaim-inline, proclaim-notinline) Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files. * bytecomp-runtime.el (eval-when-compile, eval-and-compile): In passing, mention that these macros also evaluate the body when interpreted. tests/ChangeLog addition: 2011-02-07 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test lexical scope for `block', `return-from'; add a Known-Bug-Expect-Failure for a contorted example that fails when byte-compiled.

/* Definitions of numeric types for XEmacs.
   Copyright (C) 2004 Jerry James.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
Boston, MA 02110-1301, USA.  */

/* Synched up with: Not in FSF. */

#ifndef INCLUDED_number_h_
#define INCLUDED_number_h_

/* The following types are always defined in the same manner:
   fixnum       = whatever fits in the Lisp_Object type
   integer      = union (fixnum, bignum)
   rational     = union (integer, ratio)
   float        = C double
   floating     = union(float, bigfloat)  Anybody got a better name?
   real         = union (rational, floating)
   number       = real  (should be union(real, complex) but no complex yet)

   It is up to the library-specific code to define the remaining types,
   namely: bignum, ratio, and bigfloat.  Not all of these types may be
   available.  The top-level configure script should define the symbols
   HAVE_BIGNUM, HAVE_RATIO, and HAVE_BIGFLOAT to indicate which it provides.
   If some type is not defined by the library, this is what happens:

   - bignum: bignump(x) is false for all x; any attempt to create a bignum
     causes an error to be raised.

   - ratio: we define our own structure consisting of two Lisp_Objects, which
     are presumed to be integers (i.e., either fixnums or bignums).  We do our
     own GCD calculation, which is bound to be slow, to keep the ratios
     reduced to canonical form.  (FIXME: Not yet implemented.)

   - bigfloat: bigfloat(x) is false for all x; any attempt to create a
     bigfloat causes an error to be raised.

   We (provide) the following symbols, so that Lisp code has some hope of
   using this correctly:

   - (provide 'bignum) if HAVE_BIGNUM
   - (provde 'ratio) if HAVE_RATIO
   - (provide 'bigfloat) if HAVE_BIGFLOAT
*/

/* Load the library definitions */
#ifdef WITH_GMP
#include "number-gmp.h"
#endif
#ifdef WITH_MP
#include "number-mp.h"
#endif


/********************************* Bignums **********************************/
#ifdef HAVE_BIGNUM

struct Lisp_Bignum
{
  FROB_BLOCK_LISP_OBJECT_HEADER lheader;
  bignum data;
};
typedef struct Lisp_Bignum Lisp_Bignum;

DECLARE_LISP_OBJECT (bignum, Lisp_Bignum);
#define XBIGNUM(x) XRECORD (x, bignum, Lisp_Bignum)
#define wrap_bignum(p) wrap_record (p, bignum)
#define BIGNUMP(x) RECORDP (x, bignum)
#define CHECK_BIGNUM(x) CHECK_RECORD (x, bignum)
#define CONCHECK_BIGNUM(x) CONCHECK_RECORD (x, bignum)

#define bignum_data(b) (b)->data
#define XBIGNUM_DATA(x) bignum_data (XBIGNUM (x))

#define BIGNUM_ARITH_RETURN(b,op) do				\
{								\
  Lisp_Object retval = make_bignum (0);				\
  bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b));	\
  return Fcanonicalize_number (retval);				\
} while (0)

#define BIGNUM_ARITH_RETURN1(b,op,arg) do			\
{								\
  Lisp_Object retval = make_bignum(0);				\
  bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b), arg);	\
  return Fcanonicalize_number (retval);				\
} while (0)

#if SIZEOF_EMACS_INT == SIZEOF_LONG
# define bignum_fits_emacs_int_p(b) bignum_fits_long_p(b)
# define bignum_to_emacs_int(b) bignum_to_long(b)
#elif SIZEOF_EMACS_INT == SIZEOF_INT
# define bignum_fits_emacs_int_p(b) bignum_fits_int_p(b)
# define bignum_to_emacs_int(b) bignum_to_int(b)
#else
# error Bignums currently do not work with long long Emacs integers.
#endif

extern Lisp_Object make_bignum (long);
extern Lisp_Object make_bignum_bg (bignum);
extern bignum scratch_bignum, scratch_bignum2;

#else /* !HAVE_BIGNUM */

#define BIGNUMP(x)         0
#define CHECK_BIGNUM(x)    dead_wrong_type_argument (Qbignump, x)
#define CONCHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
typedef void bignum;
#define make_bignum(l)     This XEmacs does not support bignums
#define make_bignum_bg(b)  This XEmacs does not support bignums

#endif /* HAVE_BIGNUM */

extern Lisp_Object Qbignump;
EXFUN (Fbignump, 1);


/********************************* Integers *********************************/
/* Qintegerp in lisp.h */
#define INTEGERP(x) (INTP(x) || BIGNUMP(x))
#define CHECK_INTEGER(x) do {			\
 if (!INTEGERP (x))				\
   dead_wrong_type_argument (Qintegerp, x);	\
 } while (0)
#define CONCHECK_INTEGER(x) do {		\
 if (!INTEGERP (x))				\
   x = wrong_type_argument (Qintegerp, x);	\
}  while (0)

#ifdef HAVE_BIGNUM
#define make_integer(x) \
  (NUMBER_FITS_IN_AN_EMACS_INT (x) ? make_int (x) : make_bignum (x))
#else
#define make_integer(x) make_int (x)
#endif

extern Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
EXFUN (Fintegerp, 1);
EXFUN (Fevenp, 1);
EXFUN (Foddp, 1);

/* There are varying mathematical definitions of what a natural number is,
   differing about whether 0 is inside or outside the set. The Oxford
   English Dictionary, second edition, does say that they are whole numbers,
   not fractional, but it doesn't give a bound, and gives a quotation
   talking about the natural numbers from 1 to 100. Since 100 is certainly
   *not* the upper bound on natural numbers, we can't take 1 as the lower
   bound from that example. The Real Academia Española's dictionary, not of
   English but certainly sharing the western academic tradition, says of
   "número natural":

   1.  m. Mat. Cada uno de los elementos de la sucesión 0, 1, 2, 3...

   that is, "each of the elements of the succession 0, 1, 2, 3 ...". The
   various Wikipedia articles in languages I can read agree.  It's
   reasonable to call this macro and the associated Lisp function
   NATNUMP. */

#ifdef HAVE_BIGNUM
#define NATNUMP(x) ((INTP (x) && XINT (x) >= 0) || \
                    (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0))
#else
#define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
#endif

#define CHECK_NATNUM(x) do {			\
  if (!NATNUMP (x))				\
    dead_wrong_type_argument (Qnatnump, x);	\
} while (0)

#define CONCHECK_NATNUM(x) do {			\
  if (!NATNUMP (x))				\
    x = wrong_type_argument (Qnatnump, x);	\
} while (0)


/********************************** Ratios **********************************/
#ifdef HAVE_RATIO

struct Lisp_Ratio
{
  FROB_BLOCK_LISP_OBJECT_HEADER lheader;
  ratio data;
};
typedef struct Lisp_Ratio Lisp_Ratio;

DECLARE_LISP_OBJECT (ratio, Lisp_Ratio);
#define XRATIO(x) XRECORD (x, ratio, Lisp_Ratio)
#define wrap_ratio(p) wrap_record (p, ratio)
#define RATIOP(x) RECORDP (x, ratio)
#define CHECK_RATIO(x) CHECK_RECORD (x, ratio)
#define CONCHECK_RATIO(x) CONCHECK_RECORD (x, ratio)

#define ratio_data(r) (r)->data

#define XRATIO_DATA(r) ratio_data (XRATIO (r))
#define XRATIO_NUMERATOR(r) ratio_numerator (XRATIO_DATA (r))
#define XRATIO_DENOMINATOR(r) ratio_denominator (XRATIO_DATA (r))

#define RATIO_ARITH_RETURN(r,op) do			\
{							\
  Lisp_Object retval = make_ratio (0L, 1UL);		\
  ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r));	\
  return Fcanonicalize_number (retval);			\
} while (0)

#define RATIO_ARITH_RETURN1(r,op,arg) do			\
{								\
  Lisp_Object retval = make_ratio (0L, 1UL);			\
  ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r), arg);	\
  return Fcanonicalize_number (retval);				\
} while (0)

extern Lisp_Object make_ratio (long, unsigned long);
extern Lisp_Object make_ratio_bg (bignum, bignum);
extern Lisp_Object make_ratio_rt (ratio);
extern ratio scratch_ratio, scratch_ratio2;

#else /* !HAVE_RATIO */

#define RATIOP(x)          0
#define CHECK_RATIO(x)     dead_wrong_type_argument (Qratiop, x)
#define CONCHECK_RATIO(x)  dead_wrong_type_argument (Qratiop, x)
typedef void ratio;
#define make_ratio(n,d)    This XEmacs does not support ratios
#define make_ratio_bg(n,d) This XEmacs does not support ratios

#endif /* HAVE_RATIO */

extern Lisp_Object Qratiop;
EXFUN (Fratiop, 1);


/******************************** Rationals *********************************/
extern Lisp_Object Qrationalp;

#define RATIONALP(x) (INTEGERP(x) || RATIOP(x))
#define CHECK_RATIONAL(x) do {			\
 if (!RATIONALP (x))				\
   dead_wrong_type_argument (Qrationalp, x);	\
 } while (0)
#define CONCHECK_RATIONAL(x) do {		\
 if (!RATIONALP (x))				\
   x = wrong_type_argument (Qrationalp, x);	\
}  while (0)

EXFUN (Frationalp, 1);
EXFUN (Fnumerator, 1);
EXFUN (Fdenominator, 1);


/******************************** Bigfloats *********************************/
#ifdef HAVE_BIGFLOAT
struct Lisp_Bigfloat
{
  FROB_BLOCK_LISP_OBJECT_HEADER lheader;
  bigfloat bf;
};
typedef struct Lisp_Bigfloat Lisp_Bigfloat;

DECLARE_LISP_OBJECT (bigfloat, Lisp_Bigfloat);
#define XBIGFLOAT(x) XRECORD (x, bigfloat, Lisp_Bigfloat)
#define wrap_bigfloat(p) wrap_record (p, bigfloat)
#define BIGFLOATP(x) RECORDP (x, bigfloat)
#define CHECK_BIGFLOAT(x) CHECK_RECORD (x, bigfloat)
#define CONCHECK_BIGFLOAT(x) CONCHECK_RECORD (x, bigfloat)

#define bigfloat_data(f) ((f)->bf)
#define XBIGFLOAT_DATA(x) bigfloat_data (XBIGFLOAT (x))
#define XBIGFLOAT_GET_PREC(x) bigfloat_get_prec (XBIGFLOAT_DATA (x))
#define XBIGFLOAT_SET_PREC(x,p) bigfloat_set_prec (XBIGFLOAT_DATA (x), p)

#define BIGFLOAT_ARITH_RETURN(f,op) do					\
{									\
  Lisp_Object retval = make_bigfloat (0.0, bigfloat_get_default_prec()); \
  bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f));	\
  return retval;						\
} while (0)

#define BIGFLOAT_ARITH_RETURN1(f,op,arg) do				\
{									\
  Lisp_Object retval = make_bigfloat (0.0, bigfloat_get_default_prec()); \
  bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f), arg);	\
  return retval;							\
} while (0)

extern Lisp_Object make_bigfloat (double, unsigned long);
extern Lisp_Object make_bigfloat_bf (bigfloat);
extern Lisp_Object Vdefault_float_precision;
extern bigfloat scratch_bigfloat, scratch_bigfloat2;

#else /* !HAVE_BIGFLOAT */

#define BIGFLOATP(x)         0
#define CHECK_BIGFLOAT(x)    dead_wrong_type_argument (Qbigfloatp, x)
#define CONCHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
typedef void bigfloat;
#define make_bigfloat(f)     This XEmacs does not support bigfloats
#define make_bigfloat_bf(f)  This XEmacs does not support bigfloast

#endif /* HAVE_BIGFLOAT */

extern Lisp_Object Qbigfloatp;
EXFUN (Fbigfloatp, 1);

/********************************* Floating *********************************/
extern Lisp_Object Qfloatingp;
extern Lisp_Object Qread_default_float_format, Vread_default_float_format;

#define FLOATINGP(x) (FLOATP (x) || BIGFLOATP (x))
#define CHECK_FLOATING(x) do {			\
 if (!FLOATINGP (x))				\
   dead_wrong_type_argument (Qfloatingp, x);	\
 } while (0)
#define CONCHECK_FLOATING(x) do {		\
 if (!FLOATINGP (x))				\
   x = wrong_type_argument (Qfloating, x);	\
}  while (0)

extern Lisp_Object make_floating (double);
EXFUN (Ffloatp, 1);


/********************************** Reals ***********************************/
extern Lisp_Object Qrealp;

#define REALP(x) (RATIONALP (x) || FLOATINGP (x))
#define CHECK_REAL(x) do {			\
 if (!REALP (x))				\
   dead_wrong_type_argument (Qrealp, x);	\
 } while (0)
#define CONCHECK_REAL(x) do {			\
 if (!REALP (x))				\
   x = wrong_type_argument (Qrealp, x);		\
}  while (0)

EXFUN (Frealp, 1);


/********************************* Numbers **********************************/
/* Qnumberp in lisp.h */
#define NUMBERP(x) REALP (x)
#define CHECK_NUMBER(x) do {			\
  if (!NUMBERP (x))				\
    dead_wrong_type_argument (Qnumberp, x);	\
} while (0)
#define CONCHECK_NUMBER(x) do {			\
  if (!NUMBERP (x))				\
    x = wrong_type_argument (Qnumberp, x);	\
} while (0)

EXFUN (Fcanonicalize_number, 1);

enum number_type {FIXNUM_T, BIGNUM_T, RATIO_T, FLOAT_T, BIGFLOAT_T};

extern enum number_type get_number_type (Lisp_Object);
extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);

#ifdef WITH_NUMBER_TYPES
DECLARE_INLINE_HEADER (
int
non_fixnum_number_p (Lisp_Object object))
{
  if (LRECORDP (object))
    {
      switch (XRECORD_LHEADER (object)->type)
        {
        case lrecord_type_float:
#ifdef HAVE_BIGNUM
        case lrecord_type_bignum:
#endif
#ifdef HAVE_RATIO
        case lrecord_type_ratio:
#endif
#ifdef HAVE_BIGFLOAT
        case lrecord_type_bigfloat:
#endif
          return 1;
        }
    }
  return 0;
}
#define NON_FIXNUM_NUMBER_P(X) non_fixnum_number_p (X)

#else
#define NON_FIXNUM_NUMBER_P FLOATP
#endif


#endif /* INCLUDED_number_h_ */