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