Mercurial > emacs
annotate lisp/calc/calc-macs.el @ 93156:3ef12fa772f2
* dbusbind.c (xd_read_message): Removed extra copying of message
strings. Check for NULL `interface' or `member'.
author | Michael Albinus <michael.albinus@gmx.de> |
---|---|
date | Sun, 23 Mar 2008 16:45:39 +0000 |
parents | 107ccd98fa12 |
children | 606f2d163a64 1e3a407766b9 |
rev | line source |
---|---|
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
1 ;;; calc-macs.el --- important macros for Calc |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
2 |
64325
1db49616ce05
Update copyright information.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
62442
diff
changeset
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
79702 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
5 |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
6 ;; Author: David Gillespie <daveg@synaptics.com> |
77465
1154f082efd9
Update maintainer's address.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
76595
diff
changeset
|
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
40785 | 8 |
9 ;; This file is part of GNU Emacs. | |
10 | |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by |
78215
095d08e7d6bb
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
77465
diff
changeset
|
13 ;; the Free Software Foundation; either version 3, or (at your option) |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
14 ;; any later version. |
40785 | 15 |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful, |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
19 ;; GNU General Public License for more details. |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
20 |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
21 ;; You should have received a copy of the GNU General Public License |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
24 ;; Boston, MA 02110-1301, USA. |
40785 | 25 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
26 ;;; Commentary: |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
27 |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
28 ;;; Code: |
40785 | 29 |
86476
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
30 ;; Declare functions which are defined elsewhere. |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
31 (declare-function math-zerop "calc-misc" (a)) |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
32 (declare-function math-negp "calc-misc" (a)) |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
33 (declare-function math-looks-negp "calc-misc" (a)) |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
34 (declare-function math-posp "calc-misc" (a)) |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
35 (declare-function math-compare "calc-ext" (a b)) |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
36 (declare-function math-bignum "calc" (a)) |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
37 (declare-function math-compare-bignum "calc-ext" (a b)) |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
38 |
577a47c95cf8
(math-zerop, math-negp, math-looks-negp)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
78215
diff
changeset
|
39 |
40785 | 40 (defmacro calc-wrapper (&rest body) |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
41 `(calc-do (function (lambda () |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
42 ,@body)))) |
40785 | 43 |
44 (defmacro calc-slow-wrapper (&rest body) | |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
45 `(calc-do |
41341
6ab668229754
(calc-slow-wrapper): Move (point) call outside of (function ...)
Colin Walters <walters@gnu.org>
parents:
41266
diff
changeset
|
46 (function (lambda () ,@body)) (point))) |
40785 | 47 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
48 (defmacro math-showing-full-precision (form) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
49 `(let ((calc-float-format calc-full-float-format)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
50 ,form)) |
40785 | 51 |
52 (defmacro math-with-extra-prec (delta &rest body) | |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
53 `(math-normalize |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
54 (let ((calc-internal-prec (+ calc-internal-prec ,delta))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
55 ,@body))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
56 |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
57 (defmacro math-working (msg arg) ; [Public] |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
58 `(if (eq calc-display-working-message 'lots) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
59 (math-do-working ,msg ,arg))) |
40785 | 60 |
43402
b7527fba7b15
(calc-with-default-simplification): Use &rest for body.
Colin Walters <walters@gnu.org>
parents:
41385
diff
changeset
|
61 (defmacro calc-with-default-simplification (&rest body) |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
62 `(let ((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
63 calc-simplify-mode))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
64 ,@body)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
65 |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
66 (defmacro calc-with-trail-buffer (&rest body) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
67 `(let ((save-buf (current-buffer)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
68 (calc-command-flags nil)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
69 (with-current-buffer (calc-trail-display t) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
70 (progn |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
71 (goto-char calc-trail-pointer) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
72 ,@body)))) |
40785 | 73 |
74 ;;; Faster in-line version zerop, normalized values only. | |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
75 (defsubst Math-zerop (a) ; [P N] |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
76 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
77 (and (not (memq (car a) '(bigpos bigneg))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
78 (if (eq (car a) 'float) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
79 (eq (nth 1 a) 0) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
80 (math-zerop a))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
81 (eq a 0))) |
40785 | 82 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
83 (defsubst Math-integer-negp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
84 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
85 (eq (car a) 'bigneg) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
86 (< a 0))) |
40785 | 87 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
88 (defsubst Math-integer-posp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
89 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
90 (eq (car a) 'bigpos) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
91 (> a 0))) |
40785 | 92 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
93 (defsubst Math-negp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
94 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
95 (or (eq (car a) 'bigneg) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
96 (and (not (eq (car a) 'bigpos)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
97 (if (memq (car a) '(frac float)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
98 (Math-integer-negp (nth 1 a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
99 (math-negp a)))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
100 (< a 0))) |
40785 | 101 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
102 (defsubst Math-looks-negp (a) ; [P x] [Public] |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
103 (or (Math-negp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
104 (and (consp a) (or (eq (car a) 'neg) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
105 (and (memq (car a) '(* /)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
106 (or (math-looks-negp (nth 1 a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
107 (math-looks-negp (nth 2 a)))))))) |
40785 | 108 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
109 (defsubst Math-posp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
110 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
111 (or (eq (car a) 'bigpos) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
112 (and (not (eq (car a) 'bigneg)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
113 (if (memq (car a) '(frac float)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
114 (Math-integer-posp (nth 1 a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
115 (math-posp a)))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
116 (> a 0))) |
40785 | 117 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
118 (defsubst Math-integerp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
119 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
120 (memq (car a) '(bigpos bigneg)))) |
40785 | 121 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
122 (defsubst Math-natnump (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
123 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
124 (eq (car a) 'bigpos) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
125 (>= a 0))) |
40785 | 126 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
127 (defsubst Math-ratp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
128 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
129 (memq (car a) '(bigpos bigneg frac)))) |
40785 | 130 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
131 (defsubst Math-realp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
132 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
133 (memq (car a) '(bigpos bigneg frac float)))) |
40785 | 134 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
135 (defsubst Math-anglep (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
136 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
137 (memq (car a) '(bigpos bigneg frac float hms)))) |
40785 | 138 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
139 (defsubst Math-numberp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
140 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
141 (memq (car a) '(bigpos bigneg frac float cplx polar)))) |
40785 | 142 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
143 (defsubst Math-scalarp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
144 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
145 (memq (car a) '(bigpos bigneg frac float cplx polar hms)))) |
40785 | 146 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
147 (defsubst Math-vectorp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
148 (and (consp a) (eq (car a) 'vec))) |
40785 | 149 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
150 (defsubst Math-messy-integerp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
151 (and (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
152 (eq (car a) 'float) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
153 (>= (nth 2 a) 0))) |
40785 | 154 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
155 (defsubst Math-objectp (a) ; [Public] |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
156 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
157 (memq (car a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
158 '(bigpos bigneg frac float cplx polar hms date sdev intv mod)))) |
40785 | 159 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
160 (defsubst Math-objvecp (a) ; [Public] |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
161 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
162 (memq (car a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
163 '(bigpos bigneg frac float cplx polar hms date |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
164 sdev intv mod vec)))) |
40785 | 165 |
166 ;;; Compute the negative of A. [O O; o o] [Public] | |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
167 (defsubst Math-integer-neg (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
168 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
169 (if (eq (car a) 'bigpos) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
170 (cons 'bigneg (cdr a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
171 (cons 'bigpos (cdr a))) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
172 (- a))) |
40785 | 173 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
174 (defsubst Math-equal (a b) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
175 (= (math-compare a b) 0)) |
40785 | 176 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
177 (defsubst Math-lessp (a b) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
178 (= (math-compare a b) -1)) |
40785 | 179 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
180 (defsubst Math-primp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
181 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
182 (memq (car a) '(bigpos bigneg frac float cplx polar |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
183 hms date mod var)))) |
40785 | 184 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
185 (defsubst Math-num-integerp (a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
186 (or (not (consp a)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
187 (memq (car a) '(bigpos bigneg)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
188 (and (eq (car a) 'float) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
189 (>= (nth 2 a) 0)))) |
40785 | 190 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
191 (defsubst Math-bignum-test (a) ; [B N; B s; b b] |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
192 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
193 a |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
194 (math-bignum a))) |
40785 | 195 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
196 (defsubst Math-equal-int (a b) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
197 (or (eq a b) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
198 (and (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
199 (eq (car a) 'float) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
200 (eq (nth 1 a) b) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
201 (= (nth 2 a) 0)))) |
40785 | 202 |
41266
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
203 (defsubst Math-natnum-lessp (a b) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
204 (if (consp a) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
205 (and (consp b) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
206 (= (math-compare-bignum (cdr a) (cdr b)) -1)) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
207 (or (consp b) |
c08a55ae8e5d
(calc-wrapper, calc-slow-wrapper)
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
208 (< a b)))) |
40785 | 209 |
58612
d48ee50961f3
Move provide to end of file.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
210 (provide 'calc-macs) |
d48ee50961f3
Move provide to end of file.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
211 |
52401 | 212 ;;; arch-tag: 08ba8ec2-fcff-4b80-a079-ec661bdb057e |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40910
diff
changeset
|
213 ;;; calc-macs.el ends here |