annotate src/number.h @ 5353:38e24b8be4ea

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.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 07 Feb 2011 12:01:24 +0000
parents c096d8051f89
children 8d29f1c4bb98
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
1 /* Definitions of numeric types for XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
2 Copyright (C) 2004 Jerry James.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
3
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
4 This file is part of XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
5
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
9 later version.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
10
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
14 for more details.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
15
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
5286
7e535575bf6d More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5234
diff changeset
18 the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
5234
53b88477345d Fix up FSF's Franklin Street address in number.h.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5125
diff changeset
19 Boston, MA 02110-1301, USA. */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
20
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
21 /* Synched up with: Not in FSF. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
22
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
23 #ifndef INCLUDED_number_h_
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
24 #define INCLUDED_number_h_
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
25
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
26 /* The following types are always defined in the same manner:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
27 fixnum = whatever fits in the Lisp_Object type
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
28 integer = union (fixnum, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
29 rational = union (integer, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
30 float = C double
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
31 floating = union(float, bigfloat) Anybody got a better name?
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
32 real = union (rational, floating)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
33 number = real (should be union(real, complex) but no complex yet)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
34
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
35 It is up to the library-specific code to define the remaining types,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
36 namely: bignum, ratio, and bigfloat. Not all of these types may be
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
37 available. The top-level configure script should define the symbols
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
38 HAVE_BIGNUM, HAVE_RATIO, and HAVE_BIGFLOAT to indicate which it provides.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
39 If some type is not defined by the library, this is what happens:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
40
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
41 - bignum: bignump(x) is false for all x; any attempt to create a bignum
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
42 causes an error to be raised.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
43
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
44 - ratio: we define our own structure consisting of two Lisp_Objects, which
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
45 are presumed to be integers (i.e., either fixnums or bignums). We do our
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
46 own GCD calculation, which is bound to be slow, to keep the ratios
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
47 reduced to canonical form. (FIXME: Not yet implemented.)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
48
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
49 - bigfloat: bigfloat(x) is false for all x; any attempt to create a
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
50 bigfloat causes an error to be raised.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
51
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
52 We (provide) the following symbols, so that Lisp code has some hope of
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
53 using this correctly:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
54
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
55 - (provide 'bignum) if HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
56 - (provde 'ratio) if HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
57 - (provide 'bigfloat) if HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
58 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
59
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
60 /* Load the library definitions */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
61 #ifdef WITH_GMP
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
62 #include "number-gmp.h"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
63 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
64 #ifdef WITH_MP
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
65 #include "number-mp.h"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
66 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
67
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
68
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
69 /********************************* Bignums **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
70 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
71
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
72 struct Lisp_Bignum
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
73 {
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
74 FROB_BLOCK_LISP_OBJECT_HEADER lheader;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
75 bignum data;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
76 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
77 typedef struct Lisp_Bignum Lisp_Bignum;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
78
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4678
diff changeset
79 DECLARE_LISP_OBJECT (bignum, Lisp_Bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
80 #define XBIGNUM(x) XRECORD (x, bignum, Lisp_Bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
81 #define wrap_bignum(p) wrap_record (p, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
82 #define BIGNUMP(x) RECORDP (x, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
83 #define CHECK_BIGNUM(x) CHECK_RECORD (x, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
84 #define CONCHECK_BIGNUM(x) CONCHECK_RECORD (x, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
85
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
86 #define bignum_data(b) (b)->data
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
87 #define XBIGNUM_DATA(x) bignum_data (XBIGNUM (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
88
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
89 #define BIGNUM_ARITH_RETURN(b,op) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
90 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
91 Lisp_Object retval = make_bignum (0); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
92 bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b)); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
93 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
94 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
95
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
96 #define BIGNUM_ARITH_RETURN1(b,op,arg) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
97 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
98 Lisp_Object retval = make_bignum(0); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
99 bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b), arg); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
100 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
101 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
102
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
103 #if SIZEOF_EMACS_INT == SIZEOF_LONG
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
104 # define bignum_fits_emacs_int_p(b) bignum_fits_long_p(b)
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
105 # define bignum_to_emacs_int(b) bignum_to_long(b)
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
106 #elif SIZEOF_EMACS_INT == SIZEOF_INT
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
107 # define bignum_fits_emacs_int_p(b) bignum_fits_int_p(b)
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
108 # define bignum_to_emacs_int(b) bignum_to_int(b)
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
109 #else
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
110 # error Bignums currently do not work with long long Emacs integers.
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
111 #endif
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
112
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
113 extern Lisp_Object make_bignum (long);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
114 extern Lisp_Object make_bignum_bg (bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
115 extern bignum scratch_bignum, scratch_bignum2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
116
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
117 #else /* !HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
118
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
119 #define BIGNUMP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
120 #define CHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
121 #define CONCHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
122 typedef void bignum;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
123 #define make_bignum(l) This XEmacs does not support bignums
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
124 #define make_bignum_bg(b) This XEmacs does not support bignums
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
125
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
126 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
127
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
128 extern Lisp_Object Qbignump;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
129 EXFUN (Fbignump, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
130
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
131
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
132 /********************************* Integers *********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
133 /* Qintegerp in lisp.h */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
134 #define INTEGERP(x) (INTP(x) || BIGNUMP(x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
135 #define CHECK_INTEGER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
136 if (!INTEGERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
137 dead_wrong_type_argument (Qintegerp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
138 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
139 #define CONCHECK_INTEGER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
140 if (!INTEGERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
141 x = wrong_type_argument (Qintegerp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
142 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
143
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
144 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
145 #define make_integer(x) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
146 (NUMBER_FITS_IN_AN_EMACS_INT (x) ? make_int (x) : make_bignum (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
147 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
148 #define make_integer(x) make_int (x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
149 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
150
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
151 extern Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
152 EXFUN (Fintegerp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
153 EXFUN (Fevenp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
154 EXFUN (Foddp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
155
5307
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
156 /* There are varying mathematical definitions of what a natural number is,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
157 differing about whether 0 is inside or outside the set. The Oxford
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
158 English Dictionary, second edition, does say that they are whole numbers,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
159 not fractional, but it doesn't give a bound, and gives a quotation
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
160 talking about the natural numbers from 1 to 100. Since 100 is certainly
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
161 *not* the upper bound on natural numbers, we can't take 1 as the lower
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
162 bound from that example. The Real Academia Española's dictionary, not of
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
163 English but certainly sharing the western academic tradition, says of
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
164 "número natural":
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
165
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
166 1. m. Mat. Cada uno de los elementos de la sucesión 0, 1, 2, 3...
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
167
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
168 that is, "each of the elements of the succession 0, 1, 2, 3 ...". The
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
169 various Wikipedia articles in languages I can read agree. It's
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
170 reasonable to call this macro and the associated Lisp function
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
171 NATNUMP. */
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
172
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
173 #ifdef HAVE_BIGNUM
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
174 #define NATNUMP(x) ((INTP (x) && XINT (x) >= 0) || \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
175 (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0))
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
176 #else
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
177 #define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
178 #endif
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
179
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
180 #define CHECK_NATNUM(x) do { \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
181 if (!NATNUMP (x)) \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
182 dead_wrong_type_argument (Qnatnump, x); \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
183 } while (0)
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
184
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
185 #define CONCHECK_NATNUM(x) do { \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
186 if (!NATNUMP (x)) \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
187 x = wrong_type_argument (Qnatnump, x); \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
188 } while (0)
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
189
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
190
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
191 /********************************** Ratios **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
192 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
193
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
194 struct Lisp_Ratio
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
195 {
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
196 FROB_BLOCK_LISP_OBJECT_HEADER lheader;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
197 ratio data;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
198 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
199 typedef struct Lisp_Ratio Lisp_Ratio;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
200
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4678
diff changeset
201 DECLARE_LISP_OBJECT (ratio, Lisp_Ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
202 #define XRATIO(x) XRECORD (x, ratio, Lisp_Ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
203 #define wrap_ratio(p) wrap_record (p, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
204 #define RATIOP(x) RECORDP (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
205 #define CHECK_RATIO(x) CHECK_RECORD (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
206 #define CONCHECK_RATIO(x) CONCHECK_RECORD (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
207
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
208 #define ratio_data(r) (r)->data
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
209
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
210 #define XRATIO_DATA(r) ratio_data (XRATIO (r))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
211 #define XRATIO_NUMERATOR(r) ratio_numerator (XRATIO_DATA (r))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
212 #define XRATIO_DENOMINATOR(r) ratio_denominator (XRATIO_DATA (r))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
213
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
214 #define RATIO_ARITH_RETURN(r,op) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
215 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
216 Lisp_Object retval = make_ratio (0L, 1UL); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
217 ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r)); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
218 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
219 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
220
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
221 #define RATIO_ARITH_RETURN1(r,op,arg) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
222 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
223 Lisp_Object retval = make_ratio (0L, 1UL); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
224 ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r), arg); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
225 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
226 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
227
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
228 extern Lisp_Object make_ratio (long, unsigned long);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
229 extern Lisp_Object make_ratio_bg (bignum, bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
230 extern Lisp_Object make_ratio_rt (ratio);
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
231 extern ratio scratch_ratio, scratch_ratio2;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
232
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
233 #else /* !HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
234
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
235 #define RATIOP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
236 #define CHECK_RATIO(x) dead_wrong_type_argument (Qratiop, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
237 #define CONCHECK_RATIO(x) dead_wrong_type_argument (Qratiop, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
238 typedef void ratio;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
239 #define make_ratio(n,d) This XEmacs does not support ratios
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
240 #define make_ratio_bg(n,d) This XEmacs does not support ratios
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
241
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
242 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
243
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
244 extern Lisp_Object Qratiop;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
245 EXFUN (Fratiop, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
246
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
247
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
248 /******************************** Rationals *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
249 extern Lisp_Object Qrationalp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
251 #define RATIONALP(x) (INTEGERP(x) || RATIOP(x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
252 #define CHECK_RATIONAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
253 if (!RATIONALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
254 dead_wrong_type_argument (Qrationalp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
255 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
256 #define CONCHECK_RATIONAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
257 if (!RATIONALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
258 x = wrong_type_argument (Qrationalp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
259 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
260
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
261 EXFUN (Frationalp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
262 EXFUN (Fnumerator, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
263 EXFUN (Fdenominator, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
264
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
265
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
266 /******************************** Bigfloats *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
267 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
268 struct Lisp_Bigfloat
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
269 {
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
270 FROB_BLOCK_LISP_OBJECT_HEADER lheader;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
271 bigfloat bf;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
272 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
273 typedef struct Lisp_Bigfloat Lisp_Bigfloat;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
274
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4678
diff changeset
275 DECLARE_LISP_OBJECT (bigfloat, Lisp_Bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
276 #define XBIGFLOAT(x) XRECORD (x, bigfloat, Lisp_Bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
277 #define wrap_bigfloat(p) wrap_record (p, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
278 #define BIGFLOATP(x) RECORDP (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
279 #define CHECK_BIGFLOAT(x) CHECK_RECORD (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
280 #define CONCHECK_BIGFLOAT(x) CONCHECK_RECORD (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
281
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
282 #define bigfloat_data(f) ((f)->bf)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
283 #define XBIGFLOAT_DATA(x) bigfloat_data (XBIGFLOAT (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
284 #define XBIGFLOAT_GET_PREC(x) bigfloat_get_prec (XBIGFLOAT_DATA (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
285 #define XBIGFLOAT_SET_PREC(x,p) bigfloat_set_prec (XBIGFLOAT_DATA (x), p)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
286
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
287 #define BIGFLOAT_ARITH_RETURN(f,op) do \
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
288 { \
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
289 Lisp_Object retval = make_bigfloat (0.0, bigfloat_get_default_prec()); \
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
290 bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f)); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
291 return retval; \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
292 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
293
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
294 #define BIGFLOAT_ARITH_RETURN1(f,op,arg) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
295 { \
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
296 Lisp_Object retval = make_bigfloat (0.0, bigfloat_get_default_prec()); \
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
297 bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f), arg); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
298 return retval; \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
299 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
300
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
301 extern Lisp_Object make_bigfloat (double, unsigned long);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
302 extern Lisp_Object make_bigfloat_bf (bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
303 extern Lisp_Object Vdefault_float_precision;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
304 extern bigfloat scratch_bigfloat, scratch_bigfloat2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
305
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
306 #else /* !HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
307
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
308 #define BIGFLOATP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
309 #define CHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
310 #define CONCHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
311 typedef void bigfloat;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
312 #define make_bigfloat(f) This XEmacs does not support bigfloats
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
313 #define make_bigfloat_bf(f) This XEmacs does not support bigfloast
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
314
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
315 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
316
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
317 extern Lisp_Object Qbigfloatp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
318 EXFUN (Fbigfloatp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
319
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
320 /********************************* Floating *********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
321 extern Lisp_Object Qfloatingp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
322 extern Lisp_Object Qread_default_float_format, Vread_default_float_format;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
323
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
324 #define FLOATINGP(x) (FLOATP (x) || BIGFLOATP (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
325 #define CHECK_FLOATING(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
326 if (!FLOATINGP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
327 dead_wrong_type_argument (Qfloatingp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
328 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
329 #define CONCHECK_FLOATING(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
330 if (!FLOATINGP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
331 x = wrong_type_argument (Qfloating, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
332 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
333
2057
471242c84954 [xemacs-hg @ 2004-05-03 15:19:10 by james]
james
parents: 1995
diff changeset
334 extern Lisp_Object make_floating (double);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
335 EXFUN (Ffloatp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
336
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
337
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
338 /********************************** Reals ***********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
339 extern Lisp_Object Qrealp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
340
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
341 #define REALP(x) (RATIONALP (x) || FLOATINGP (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
342 #define CHECK_REAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
343 if (!REALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
344 dead_wrong_type_argument (Qrealp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
345 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
346 #define CONCHECK_REAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
347 if (!REALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
348 x = wrong_type_argument (Qrealp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
349 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
350
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
351 EXFUN (Frealp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
352
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
353
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
354 /********************************* Numbers **********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
355 /* Qnumberp in lisp.h */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
356 #define NUMBERP(x) REALP (x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
357 #define CHECK_NUMBER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
358 if (!NUMBERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
359 dead_wrong_type_argument (Qnumberp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
360 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
361 #define CONCHECK_NUMBER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
362 if (!NUMBERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
363 x = wrong_type_argument (Qnumberp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
364 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
365
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
366 EXFUN (Fcanonicalize_number, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
367
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
368 enum number_type {FIXNUM_T, BIGNUM_T, RATIO_T, FLOAT_T, BIGFLOAT_T};
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
369
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
370 extern enum number_type get_number_type (Lisp_Object);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
371 extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
372
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
373 #ifdef WITH_NUMBER_TYPES
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
374 DECLARE_INLINE_HEADER (
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
375 int
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
376 non_fixnum_number_p (Lisp_Object object))
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
377 {
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
378 if (LRECORDP (object))
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
379 {
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
380 switch (XRECORD_LHEADER (object)->type)
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
381 {
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
382 case lrecord_type_float:
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
383 #ifdef HAVE_BIGNUM
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
384 case lrecord_type_bignum:
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
385 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
386 #ifdef HAVE_RATIO
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
387 case lrecord_type_ratio:
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
388 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
389 #ifdef HAVE_BIGFLOAT
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
390 case lrecord_type_bigfloat:
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
391 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
392 return 1;
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
393 }
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
394 }
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
395 return 0;
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
396 }
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
397 #define NON_FIXNUM_NUMBER_P(X) non_fixnum_number_p (X)
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
398
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
399 #else
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
400 #define NON_FIXNUM_NUMBER_P FLOATP
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
401 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
402
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
403
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
404 #endif /* INCLUDED_number_h_ */