1 ;;; calc-macs.el --- important macros for Calc
3 ;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; Declare functions which are defined elsewhere.
28 (declare-function math-zerop "calc-misc" (a))
29 (declare-function math-negp "calc-misc" (a))
30 (declare-function math-looks-negp "calc-misc" (a))
31 (declare-function math-posp "calc-misc" (a))
32 (declare-function math-compare "calc-ext" (a b))
33 (declare-function math-bignum "calc" (a))
34 (declare-function math-compare-bignum "calc-ext" (a b))
37 (defmacro calc-wrapper (&rest body)
38 `(calc-do (function (lambda ()
41 (defmacro calc-slow-wrapper (&rest body)
43 (function (lambda () ,@body)) (point)))
45 (defmacro math-showing-full-precision (form)
46 `(let ((calc-float-format calc-full-float-format))
49 (defmacro math-with-extra-prec (delta &rest body)
51 (let ((calc-internal-prec (+ calc-internal-prec ,delta)))
54 (defmacro math-working (msg arg) ; [Public]
55 `(if (eq calc-display-working-message 'lots)
56 (math-do-working ,msg ,arg)))
58 (defmacro calc-with-default-simplification (&rest body)
59 `(let ((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num)))
63 (defmacro calc-with-trail-buffer (&rest body)
64 `(let ((save-buf (current-buffer))
65 (calc-command-flags nil))
66 (with-current-buffer (calc-trail-display t)
68 (goto-char calc-trail-pointer)
71 ;;; Faster in-line version zerop, normalized values only.
72 (defsubst Math-zerop (a) ; [P N]
74 (and (not (memq (car a) '(bigpos bigneg)))
75 (if (eq (car a) 'float)
80 (defsubst Math-integer-negp (a)
85 (defsubst Math-integer-posp (a)
90 (defsubst Math-negp (a)
92 (or (eq (car a) 'bigneg)
93 (and (not (eq (car a) 'bigpos))
94 (if (memq (car a) '(frac float))
95 (Math-integer-negp (nth 1 a))
99 (defsubst Math-looks-negp (a) ; [P x] [Public]
101 (and (consp a) (or (eq (car a) 'neg)
102 (and (memq (car a) '(* /))
103 (or (math-looks-negp (nth 1 a))
104 (math-looks-negp (nth 2 a))))))))
106 (defsubst Math-posp (a)
108 (or (eq (car a) 'bigpos)
109 (and (not (eq (car a) 'bigneg))
110 (if (memq (car a) '(frac float))
111 (Math-integer-posp (nth 1 a))
115 (defsubst Math-integerp (a)
117 (memq (car a) '(bigpos bigneg))))
119 (defsubst Math-natnump (a)
124 (defsubst Math-ratp (a)
126 (memq (car a) '(bigpos bigneg frac))))
128 (defsubst Math-realp (a)
130 (memq (car a) '(bigpos bigneg frac float))))
132 (defsubst Math-anglep (a)
134 (memq (car a) '(bigpos bigneg frac float hms))))
136 (defsubst Math-numberp (a)
138 (memq (car a) '(bigpos bigneg frac float cplx polar))))
140 (defsubst Math-scalarp (a)
142 (memq (car a) '(bigpos bigneg frac float cplx polar hms))))
144 (defsubst Math-vectorp (a)
145 (and (consp a) (eq (car a) 'vec)))
147 (defsubst Math-messy-integerp (a)
152 (defsubst Math-objectp (a) ; [Public]
155 '(bigpos bigneg frac float cplx polar hms date sdev intv mod))))
157 (defsubst Math-objvecp (a) ; [Public]
160 '(bigpos bigneg frac float cplx polar hms date
161 sdev intv mod vec))))
163 ;;; Compute the negative of A. [O O; o o] [Public]
164 (defsubst Math-integer-neg (a)
166 (if (eq (car a) 'bigpos)
167 (cons 'bigneg (cdr a))
168 (cons 'bigpos (cdr a)))
171 (defsubst Math-equal (a b)
172 (= (math-compare a b) 0))
174 (defsubst Math-lessp (a b)
175 (= (math-compare a b) -1))
177 (defsubst Math-primp (a)
179 (memq (car a) '(bigpos bigneg frac float cplx polar
182 (defsubst Math-num-integerp (a)
184 (memq (car a) '(bigpos bigneg))
185 (and (eq (car a) 'float)
188 (defsubst Math-bignum-test (a) ; [B N; B s; b b]
193 (defsubst Math-equal-int (a b)
200 (defsubst Math-natnum-lessp (a b)
203 (= (math-compare-bignum (cdr a) (cdr b)) -1))
209 ;;; calc-macs.el ends here