# HG changeset patch # User Jay Belanger # Date 1101332704 0 # Node ID 562c6a62c99eccae5bc3002d8da06c7c411d60a2 # Parent 0a85050b3bb48410a4f1dbcff706b13c64a2bba5 (math-scalar-functions, math-nonscalar-functions) (math-scalar-if-args-functions, math-real-functions) (math-positive-functions, math-nonnegative-functions) (math-real-scalar-functions, math-real-if-arg-functions) (math-integer-functions, math-num-integer-functions) (math-rounding-functions, math-float-rounding-functions) (math-integer-if-args-functions, math-super-types): Move declarations to earlier in file. (math-unit-prefixes): Declared it. (math-floor-prec, math-trunc-prec): New variables. (math-trunc-fancy): Replace variable prec by declared variable. (math-floor-fancy): Replace variable prec by declared variable. (math-com-bterms): New variable. (math-commutative-equal, math-commutative-collect): Replace variable bterms by declared variable. diff -r 0a85050b3bb4 -r 562c6a62c99e lisp/calc/calc-arith.el --- a/lisp/calc/calc-arith.el Wed Nov 24 21:44:23 2004 +0000 +++ b/lisp/calc/calc-arith.el Wed Nov 24 21:45:04 2004 +0000 @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie -;; Maintainers: D. Goel -;; Colin Walters +;; Maintainer: Jay Belanger ;; This file is part of GNU Emacs. @@ -34,6 +33,70 @@ (defun calc-Need-calc-arith () nil) +;;; The following lists are not exhaustive. +(defvar math-scalar-functions '(calcFunc-det + calcFunc-cnorm calcFunc-rnorm + calcFunc-vlen calcFunc-vcount + calcFunc-vsum calcFunc-vprod + calcFunc-vmin calcFunc-vmax)) + +(defvar math-nonscalar-functions '(vec calcFunc-idn calcFunc-diag + calcFunc-cvec calcFunc-index + calcFunc-trn + | calcFunc-append + calcFunc-cons calcFunc-rcons + calcFunc-tail calcFunc-rhead)) + +(defvar math-scalar-if-args-functions '(+ - * / neg)) + +(defvar math-real-functions '(calcFunc-arg + calcFunc-re calcFunc-im + calcFunc-floor calcFunc-ceil + calcFunc-trunc calcFunc-round + calcFunc-rounde calcFunc-roundu + calcFunc-ffloor calcFunc-fceil + calcFunc-ftrunc calcFunc-fround + calcFunc-frounde calcFunc-froundu)) + +(defvar math-positive-functions '()) + +(defvar math-nonnegative-functions '(calcFunc-cnorm calcFunc-rnorm + calcFunc-vlen calcFunc-vcount)) + +(defvar math-real-scalar-functions '(% calcFunc-idiv calcFunc-abs + calcFunc-choose calcFunc-perm + calcFunc-eq calcFunc-neq + calcFunc-lt calcFunc-gt + calcFunc-leq calcFunc-geq + calcFunc-lnot + calcFunc-max calcFunc-min)) + +(defvar math-real-if-arg-functions '(calcFunc-sin calcFunc-cos + calcFunc-tan calcFunc-arctan + calcFunc-sinh calcFunc-cosh + calcFunc-tanh calcFunc-exp + calcFunc-gamma calcFunc-fact)) + +(defvar math-integer-functions '(calcFunc-idiv + calcFunc-isqrt calcFunc-ilog + calcFunc-vlen calcFunc-vcount)) + +(defvar math-num-integer-functions '()) + +(defvar math-rounding-functions '(calcFunc-floor + calcFunc-ceil + calcFunc-round calcFunc-trunc + calcFunc-rounde calcFunc-roundu)) + +(defvar math-float-rounding-functions '(calcFunc-ffloor + calcFunc-fceil + calcFunc-fround calcFunc-ftrunc + calcFunc-frounde calcFunc-froundu)) + +(defvar math-integer-if-args-functions '(+ - * % neg calcFunc-abs + calcFunc-min calcFunc-max + calcFunc-choose calcFunc-perm)) + ;;; Arithmetic. @@ -164,6 +227,19 @@ ;;; TYPES is a list of type symbols (any, int, frac, ...) ;;; RANGE is a sorted vector of intervals describing the range. +(defvar math-super-types + '((int numint rat real number) + (numint real number) + (frac rat real number) + (rat real number) + (float real number) + (real number) + (number) + (scalar) + (matrix vector) + (vector) + (const))) + (defun math-setup-declarations () (or (eq math-decls-cache-tag (calc-var-value 'var-Decls)) (let ((p (calc-var-value 'var-Decls)) @@ -214,19 +290,6 @@ (error nil))))) (setq math-decls-all (assq 'var-All math-decls-cache))))) -(defvar math-super-types - '((int numint rat real number) - (numint real number) - (frac rat real number) - (rat real number) - (float real number) - (real number) - (number) - (scalar) - (matrix vector) - (vector) - (const))) - (defun math-known-scalarp (a &optional assume-scalar) (math-setup-declarations) (if (if calc-matrix-mode @@ -819,71 +882,6 @@ (math-reject-arg a 'objectp 'quiet)))) -;;; The following lists are not exhaustive. -(defvar math-scalar-functions '(calcFunc-det - calcFunc-cnorm calcFunc-rnorm - calcFunc-vlen calcFunc-vcount - calcFunc-vsum calcFunc-vprod - calcFunc-vmin calcFunc-vmax)) - -(defvar math-nonscalar-functions '(vec calcFunc-idn calcFunc-diag - calcFunc-cvec calcFunc-index - calcFunc-trn - | calcFunc-append - calcFunc-cons calcFunc-rcons - calcFunc-tail calcFunc-rhead)) - -(defvar math-scalar-if-args-functions '(+ - * / neg)) - -(defvar math-real-functions '(calcFunc-arg - calcFunc-re calcFunc-im - calcFunc-floor calcFunc-ceil - calcFunc-trunc calcFunc-round - calcFunc-rounde calcFunc-roundu - calcFunc-ffloor calcFunc-fceil - calcFunc-ftrunc calcFunc-fround - calcFunc-frounde calcFunc-froundu)) - -(defvar math-positive-functions '()) - -(defvar math-nonnegative-functions '(calcFunc-cnorm calcFunc-rnorm - calcFunc-vlen calcFunc-vcount)) - -(defvar math-real-scalar-functions '(% calcFunc-idiv calcFunc-abs - calcFunc-choose calcFunc-perm - calcFunc-eq calcFunc-neq - calcFunc-lt calcFunc-gt - calcFunc-leq calcFunc-geq - calcFunc-lnot - calcFunc-max calcFunc-min)) - -(defvar math-real-if-arg-functions '(calcFunc-sin calcFunc-cos - calcFunc-tan calcFunc-arctan - calcFunc-sinh calcFunc-cosh - calcFunc-tanh calcFunc-exp - calcFunc-gamma calcFunc-fact)) - -(defvar math-integer-functions '(calcFunc-idiv - calcFunc-isqrt calcFunc-ilog - calcFunc-vlen calcFunc-vcount)) - -(defvar math-num-integer-functions '()) - -(defvar math-rounding-functions '(calcFunc-floor - calcFunc-ceil - calcFunc-round calcFunc-trunc - calcFunc-rounde calcFunc-roundu)) - -(defvar math-float-rounding-functions '(calcFunc-ffloor - calcFunc-fceil - calcFunc-fround calcFunc-ftrunc - calcFunc-frounde calcFunc-froundu)) - -(defvar math-integer-if-args-functions '(+ - * % neg calcFunc-abs - calcFunc-min calcFunc-max - calcFunc-choose calcFunc-perm)) - - ;;;; Arithmetic. (defsubst calcFunc-neg (a) @@ -2185,6 +2183,10 @@ (defalias 'calcFunc-float 'math-float) +;; The variable math-trunc-prec is local to math-trunc in calc-misc.el, +;; but used by math-trunc-fancy which is called by math-trunc. +(defvar math-trunc-prec) + (defun math-trunc-fancy (a) (cond ((eq (car a) 'frac) (math-quotient (nth 1 a) (nth 2 a))) ((eq (car a) 'cplx) (math-trunc (nth 1 a))) @@ -2214,7 +2216,7 @@ (math-trunc (nth 3 a))))) ((math-provably-integerp a) a) ((Math-vectorp a) - (math-map-vec (function (lambda (x) (math-trunc x prec))) a)) + (math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a)) ((math-infinitep a) (if (or (math-posp a) (math-negp a)) a @@ -2251,6 +2253,10 @@ a (math-float (math-trunc a prec)))) +;; The variable math-floor-prec is local to math-floor in calc-misc.el, +;; but used by math-floor-fancy which is called by math-floor. +(defvar math-floor-prec) + (defun math-floor-fancy (a) (cond ((math-provably-integerp a) a) ((eq (car a) 'hms) @@ -2629,6 +2635,11 @@ (defvar math-combine-prod-e '(var e var-e)) ;;; The following is expanded out four ways for speed. + +;; math-unit-prefixes is defined in calc-units.el, +;; but used here. +(defvar math-unit-prefixes) + (defun math-combine-prod (a b inva invb scalar-okay) (cond ((or (and inva (Math-zerop a)) @@ -2761,23 +2772,28 @@ (math-div a b) (math-mul a b))))) +;; The variable math-com-bterms is local to math-commutative-equal, +;; but is used by math-commutative collect, which is called by +;; math-commutative-equal. +(defvar math-com-bterms) + (defun math-commutative-equal (a b) (if (memq (car-safe a) '(+ -)) (and (memq (car-safe b) '(+ -)) - (let ((bterms nil) aterms p) + (let ((math-com-bterms nil) aterms p) (math-commutative-collect b nil) - (setq aterms bterms bterms nil) + (setq aterms math-com-bterms math-com-bterms nil) (math-commutative-collect a nil) - (and (= (length aterms) (length bterms)) + (and (= (length aterms) (length math-com-bterms)) (progn (while (and aterms (progn - (setq p bterms) + (setq p math-com-bterms) (while (and p (not (equal (car aterms) (car p)))) (setq p (cdr p))) p)) - (setq bterms (delq (car p) bterms) + (setq math-com-bterms (delq (car p) math-com-bterms) aterms (cdr aterms))) (not aterms))))) (equal a b))) @@ -2791,7 +2807,7 @@ (progn (math-commutative-collect (nth 1 b) neg) (math-commutative-collect (nth 2 b) (not neg))) - (setq bterms (cons (if neg (math-neg b) b) bterms))))) + (setq math-com-bterms (cons (if neg (math-neg b) b) math-com-bterms))))) ;;; arch-tag: 6c396b5b-14c6-40ed-bb2a-7cc2e8111465 ;;; calc-arith.el ends here