view lisp/calc/calc-macs.el @ 109179:8cfee7d2955f

Convert DEFUNs to standard C. * src/alloc.c: Convert DEFUNs to standard C. * src/buffer.c: * src/bytecode.c: * src/callint.c: * src/callproc.c: * src/casefiddle.c: * src/casetab.c: * src/category.c: * src/character.c: * src/charset.c: * src/chartab.c: * src/cmds.c: * src/coding.c: * src/composite.c: * src/data.c: * src/dbusbind.c: * src/dired.c: * src/dispnew.c: * src/doc.c: * src/dosfns.c: * src/editfns.c: * src/emacs.c: * src/eval.c: * src/fileio.c: * src/filelock.c: * src/floatfns.c: * src/fns.c: * src/font.c: * src/fontset.c: * src/frame.c: * src/fringe.c: * src/image.c: * src/indent.c: * src/insdel.c: * src/keyboard.c: * src/keymap.c: * src/lread.c: * src/macros.c: * src/marker.c: * src/menu.c: * src/minibuf.c: * src/msdos.c: * src/nsfns.m: * src/nsmenu.m: * src/nsselect.m: * src/print.c: * src/process.c: * src/search.c: * src/sound.c: * src/syntax.c: * src/term.c: * src/terminal.c: * src/textprop.c: * src/undo.c: * src/w16select.c: * src/w32console.c: * src/w32fns.c: * src/w32font.c: * src/w32menu.c: * src/w32proc.c: * src/w32select.c: * src/window.c: * src/xdisp.c: * src/xfaces.c: * src/xfns.c: * src/xmenu.c: * src/xselect.c: * src/xsettings.c: * src/xsmfns.c: Likewise.

;;; calc-macs.el --- important macros for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.

;; Author: David Gillespie <[e-mail]>
;; Maintainer: Jay Belanger <[e-mail]>

;; This file is part of GNU Emacs.

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

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

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

;; Declare functions which are defined elsewhere.
(declare-function math-zerop "calc-misc" (a))
(declare-function math-negp "calc-misc" (a))
(declare-function math-looks-negp "calc-misc" (a))
(declare-function math-posp "calc-misc" (a))
(declare-function math-compare "calc-ext" (a b))
(declare-function math-bignum "calc" (a))
(declare-function math-compare-bignum "calc-ext" (a b))


(defmacro calc-wrapper (&rest body)
  `(calc-do (function (lambda ()
			,@body))))

(defmacro calc-slow-wrapper (&rest body)
  `(calc-do
    (function (lambda () ,@body)) (point)))

(defmacro math-showing-full-precision (form)
  `(let ((calc-float-format calc-full-float-format))
     ,form))

(defmacro math-with-extra-prec (delta &rest body)
  `(math-normalize
    (let ((calc-internal-prec (+ calc-internal-prec ,delta)))
      ,@body)))

(defmacro math-working (msg arg)	; [Public]
  `(if (eq calc-display-working-message 'lots)
       (math-do-working ,msg ,arg)))

(defmacro calc-with-default-simplification (&rest body)
  `(let ((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num)))
				  calc-simplify-mode)))
     ,@body))

(defmacro calc-with-trail-buffer (&rest body)
  `(let ((save-buf (current-buffer))
	 (calc-command-flags nil))
     (with-current-buffer (calc-trail-display t)
       (progn
	 (goto-char calc-trail-pointer)
	 ,@body))))

;;; Faster in-line version zerop, normalized values only.
(defsubst Math-zerop (a)		; [P N]
  (if (consp a)
      (and (not (memq (car a) '(bigpos bigneg)))
	   (if (eq (car a) 'float)
	       (eq (nth 1 a) 0)
	     (math-zerop a)))
    (eq a 0)))

(defsubst Math-integer-negp (a)
  (if (consp a)
      (eq (car a) 'bigneg)
    (< a 0)))

(defsubst Math-integer-posp (a)
  (if (consp a)
      (eq (car a) 'bigpos)
    (> a 0)))

(defsubst Math-negp (a)
  (if (consp a)
      (or (eq (car a) 'bigneg)
	  (and (not (eq (car a) 'bigpos))
	       (if (memq (car a) '(frac float))
		   (Math-integer-negp (nth 1 a))
		 (math-negp a))))
    (< a 0)))

(defsubst Math-looks-negp (a)		; [P x] [Public]
  (or (Math-negp a)
      (and (consp a) (or (eq (car a) 'neg)
			 (and (memq (car a) '(* /))
			      (or (math-looks-negp (nth 1 a))
				  (math-looks-negp (nth 2 a))))))))

(defsubst Math-posp (a)
  (if (consp a)
      (or (eq (car a) 'bigpos)
	  (and (not (eq (car a) 'bigneg))
	       (if (memq (car a) '(frac float))
		   (Math-integer-posp (nth 1 a))
		 (math-posp a))))
    (> a 0)))

(defsubst Math-integerp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg))))

(defsubst Math-natnump (a)
  (if (consp a)
      (eq (car a) 'bigpos)
    (>= a 0)))

(defsubst Math-ratp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac))))

(defsubst Math-realp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float))))

(defsubst Math-anglep (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float hms))))

(defsubst Math-numberp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float cplx polar))))

(defsubst Math-scalarp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float cplx polar hms))))

(defsubst Math-vectorp (a)
  (and (consp a) (eq (car a) 'vec)))

(defsubst Math-messy-integerp (a)
  (and (consp a)
       (eq (car a) 'float)
       (>= (nth 2 a) 0)))

(defsubst Math-objectp (a)		;  [Public]
  (or (not (consp a))
      (memq (car a)
	    '(bigpos bigneg frac float cplx polar hms date sdev intv mod))))

(defsubst Math-objvecp (a)		;  [Public]
  (or (not (consp a))
      (memq (car a)
	    '(bigpos bigneg frac float cplx polar hms date
		     sdev intv mod vec))))

;;; Compute the negative of A.  [O O; o o] [Public]
(defsubst Math-integer-neg (a)
  (if (consp a)
      (if (eq (car a) 'bigpos)
	  (cons 'bigneg (cdr a))
	(cons 'bigpos (cdr a)))
    (- a)))

(defsubst Math-equal (a b)
  (= (math-compare a b) 0))

(defsubst Math-lessp (a b)
  (= (math-compare a b) -1))

(defsubst Math-primp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float cplx polar
			     hms date mod var))))

(defsubst Math-num-integerp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg))
      (and (eq (car a) 'float)
	   (>= (nth 2 a) 0))))

(defsubst Math-bignum-test (a)		; [B N; B s; b b]
  (if (consp a)
      a
    (math-bignum a)))

(defsubst Math-equal-int (a b)
  (or (eq a b)
      (and (consp a)
	   (eq (car a) 'float)
	   (eq (nth 1 a) b)
	   (= (nth 2 a) 0))))

(defsubst Math-natnum-lessp (a b)
  (if (consp a)
      (and (consp b)
	   (= (math-compare-bignum (cdr a) (cdr b)) -1))
    (or (consp b)
	(< a b))))

(provide 'calc-macs)

;; arch-tag: 08ba8ec2-fcff-4b80-a079-ec661bdb057e
;;; calc-macs.el ends here