Initial import of Calc 2.02f.

1 files changed, 1305 insertions, 0 deletions

diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
new file mode 100644
index 00000000000..7265be641ca
--- /dev/null
+++ b/lisp/calc/calc-map.el
@@ -0,0 +1,1305 @@
+;; Calculator for GNU Emacs, part II [calc-map.el]
+;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
+;; Written by Dave Gillespie, daveg@synaptics.com.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+
+
+;; This file is autoloaded from calc-ext.el.
+(require 'calc-ext)
+
+(require 'calc-macs)
+
+(defun calc-Need-calc-map () nil)
+
+
+(defun calc-apply (&optional oper)
+  (interactive)
+  (calc-wrapper
+   (let* ((sel-mode nil)
+	  (calc-dollar-values (mapcar 'calc-get-stack-element
+				      (nthcdr calc-stack-top calc-stack)))
+	  (calc-dollar-used 0)
+	  (oper (or oper (calc-get-operator "Apply"
+					    (if (math-vectorp (calc-top 1))
+						(1- (length (calc-top 1)))
+					      -1))))
+	  (expr (calc-top-n (1+ calc-dollar-used))))
+     (message "Working...")
+     (calc-set-command-flag 'clear-message)
+     (calc-enter-result (1+ calc-dollar-used)
+			(concat (substring "apl" 0 (- 4 (length (nth 2 oper))))
+				(nth 2 oper))
+			(list 'calcFunc-apply
+			      (math-calcFunc-to-var (nth 1 oper))
+			      expr))))
+)
+
+(defun calc-reduce (&optional oper accum)
+  (interactive)
+  (calc-wrapper
+   (let* ((sel-mode nil)
+	  (nest (calc-is-hyperbolic))
+	  (rev (calc-is-inverse))
+	  (nargs (if (and nest (not rev)) 2 1))
+	  (calc-dollar-values (mapcar 'calc-get-stack-element
+				      (nthcdr calc-stack-top calc-stack)))
+	  (calc-dollar-used 0)
+	  (calc-mapping-dir (and (not accum) (not nest) ""))
+	  (oper (or oper (calc-get-operator
+			  (if nest
+			      (concat (if accum "Accumulate " "")
+				      (if rev "Fixed Point" "Nest"))
+			    (concat (if rev "Inv " "")
+				    (if accum "Accumulate" "Reduce")))
+			  (if nest 1 2)))))
+     (message "Working...")
+     (calc-set-command-flag 'clear-message)
+     (calc-enter-result (+ calc-dollar-used nargs)
+			(concat (substring (if nest
+					       (if rev "fxp" "nst")
+					     (if accum "acc" "red"))
+					   0 (- 4 (length (nth 2 oper))))
+				(nth 2 oper))
+			(if nest
+			    (cons (if rev
+				      (if accum 'calcFunc-afixp 'calcFunc-fixp)
+				    (if accum 'calcFunc-anest 'calcFunc-nest))
+				  (cons (math-calcFunc-to-var (nth 1 oper))
+					(calc-top-list-n
+					 nargs (1+ calc-dollar-used))))
+			  (list (if accum
+				    (if rev 'calcFunc-raccum 'calcFunc-accum)
+				  (intern (concat "calcFunc-"
+						  (if rev "r" "")
+						  "reduce"
+						  calc-mapping-dir)))
+				(math-calcFunc-to-var (nth 1 oper))
+				(calc-top-n (1+ calc-dollar-used)))))))
+)
+
+(defun calc-accumulate (&optional oper)
+  (interactive)
+  (calc-reduce oper t)
+)
+
+(defun calc-map (&optional oper)
+  (interactive)
+  (calc-wrapper
+   (let* ((sel-mode nil)
+	  (calc-dollar-values (mapcar 'calc-get-stack-element
+				      (nthcdr calc-stack-top calc-stack)))
+	  (calc-dollar-used 0)
+	  (calc-mapping-dir "")
+	  (oper (or oper (calc-get-operator "Map")))
+	  (nargs (car oper)))
+     (message "Working...")
+     (calc-set-command-flag 'clear-message)
+     (calc-enter-result (+ nargs calc-dollar-used)
+			(concat (substring "map" 0 (- 4 (length (nth 2 oper))))
+				(nth 2 oper))
+			(cons (intern (concat "calcFunc-map" calc-mapping-dir))
+			      (cons (math-calcFunc-to-var (nth 1 oper))
+				    (calc-top-list-n
+				     nargs
+				     (1+ calc-dollar-used)))))))
+)
+
+(defun calc-map-equation (&optional oper)
+  (interactive)
+  (calc-wrapper
+   (let* ((sel-mode nil)
+	  (calc-dollar-values (mapcar 'calc-get-stack-element
+				      (nthcdr calc-stack-top calc-stack)))
+	  (calc-dollar-used 0)
+	  (oper (or oper (calc-get-operator "Map-equation")))
+	  (nargs (car oper)))
+     (message "Working...")
+     (calc-set-command-flag 'clear-message)
+     (calc-enter-result (+ nargs calc-dollar-used)
+			(concat (substring "map" 0 (- 4 (length (nth 2 oper))))
+				(nth 2 oper))
+			(cons (if (calc-is-inverse)
+				  'calcFunc-mapeqr
+				(if (calc-is-hyperbolic)
+				    'calcFunc-mapeqp 'calcFunc-mapeq))
+			      (cons (math-calcFunc-to-var (nth 1 oper))
+				    (calc-top-list-n
+				     nargs
+				     (1+ calc-dollar-used)))))))
+)
+
+(defun calc-map-stack ()
+  "This is meant to be called by calc-keypad mode."
+  (interactive)
+  (let ((calc-verify-arglist nil))
+    (calc-unread-command ?\$)
+    (calc-map))
+)
+
+(defun calc-outer-product (&optional oper)
+  (interactive)
+  (calc-wrapper
+   (let* ((sel-mode nil)
+	  (calc-dollar-values (mapcar 'calc-get-stack-element
+				      (nthcdr calc-stack-top calc-stack)))
+	  (calc-dollar-used 0)
+	  (oper (or oper (calc-get-operator "Outer" 2))))
+     (message "Working...")
+     (calc-set-command-flag 'clear-message)
+     (calc-enter-result (+ 2 calc-dollar-used)
+			(concat (substring "out" 0 (- 4 (length (nth 2 oper))))
+				(nth 2 oper))
+			(cons 'calcFunc-outer
+			      (cons (math-calcFunc-to-var (nth 1 oper))
+				    (calc-top-list-n
+				     2 (1+ calc-dollar-used)))))))
+)
+
+(defun calc-inner-product (&optional mul-oper add-oper)
+  (interactive)
+  (calc-wrapper
+   (let* ((sel-mode nil)
+	  (calc-dollar-values (mapcar 'calc-get-stack-element
+				      (nthcdr calc-stack-top calc-stack)))
+	  (calc-dollar-used 0)
+	  (mul-oper (or mul-oper (calc-get-operator "Inner (Mult)" 2)))
+	  (mul-used calc-dollar-used)
+	  (calc-dollar-values (if (> mul-used 0)
+				  (cdr calc-dollar-values)
+				calc-dollar-values))
+	  (calc-dollar-used 0)
+	  (add-oper (or add-oper (calc-get-operator "Inner (Add)" 2))))
+     (message "Working...")
+     (calc-set-command-flag 'clear-message)
+     (calc-enter-result (+ 2 mul-used calc-dollar-used)
+			(concat "in"
+				(substring (nth 2 mul-oper) 0 1)
+				(substring (nth 2 add-oper) 0 1))
+			(nconc (list 'calcFunc-inner
+				     (math-calcFunc-to-var (nth 1 mul-oper))
+				     (math-calcFunc-to-var (nth 1 add-oper)))
+			       (calc-top-list-n
+				2 (+ 1 mul-used calc-dollar-used))))))
+)
+
+;;; Return a list of the form (nargs func name)
+(defun calc-get-operator (msg &optional nargs)
+  (setq calc-aborted-prefix nil)
+  (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil)
+	done key oper (which 0)
+	(msgs '( "(Press ? for help)"
+		 "+, -, *, /, ^, %, \\, :, &, !, |, Neg"
+		 "SHIFT + Abs, conJ, arG; maX, miN; Floor, Round; sQrt"
+		 "SHIFT + Inv, Hyp; Sin, Cos, Tan; Exp, Ln, logB"
+		 "Algebra + Simp, Esimp, Deriv, Integ, !, =, etc."
+		 "Binary + And, Or, Xor, Diff; l/r/t/L/R shifts; Not, Clip"
+		 "Conversions + Deg, Rad, HMS; Float; SHIFT + Fraction"
+		 "Functions + Re, Im; Hypot; Mant, Expon, Scale; etc."
+		 "Kombinatorics + Dfact, Lcm, Gcd, Choose; Random; etc."
+		 "Time/date + newYear, Incmonth, etc."
+		 "Vectors + Length, Row, Col, Diag, Mask, etc."
+		 "_ = mapr/reducea, : = mapc/reduced, = = reducer"
+		 "X or Z = any function by name; ' = alg entry; $ = stack")))
+    (while (not done)
+      (message "%s%s: %s: %s%s%s"
+	       msg
+	       (cond ((equal calc-mapping-dir "r") " rows")
+		     ((equal calc-mapping-dir "c") " columns")
+		     ((equal calc-mapping-dir "a") " across")
+		     ((equal calc-mapping-dir "d") " down")
+		     (t ""))
+	       (if forcenargs
+		   (format "(%d arg%s)"
+			   forcenargs (if (= forcenargs 1) "" "s"))
+		 (nth which msgs))
+	       (if inv "Inv " "") (if hyp "Hyp " "")
+	       (if prefix (concat (char-to-string prefix) "-") ""))
+      (setq key (read-char))
+      (if (>= key 128) (setq key (- key 128)))
+      (cond ((memq key '(?\C-g ?q))
+	     (keyboard-quit))
+	    ((memq key '(?\C-u ?\e)))
+	    ((= key ??)
+	     (setq which (% (1+ which) (length msgs))))
+	    ((and (= key ?I) (null prefix))
+	     (setq inv (not inv)))
+	    ((and (= key ?H) (null prefix))
+	     (setq hyp (not hyp)))
+	    ((and (eq key prefix) (not (eq key ?v)))
+	     (setq prefix nil))
+	    ((and (memq key '(?a ?b ?c ?f ?k ?s ?t ?u ?v ?V))
+		  (null prefix))
+	     (setq prefix (downcase key)))
+	    ((and (eq key ?\=) (null prefix))
+	     (if calc-mapping-dir
+		 (setq calc-mapping-dir (if (equal calc-mapping-dir "r")
+					    "" "r"))
+	       (beep)))
+	    ((and (eq key ?\_) (null prefix))
+	     (if calc-mapping-dir
+		 (if (string-match "map$" msg)
+		     (setq calc-mapping-dir (if (equal calc-mapping-dir "r")
+						"" "r"))
+		   (setq calc-mapping-dir (if (equal calc-mapping-dir "a")
+					      "" "a")))
+	       (beep)))
+	    ((and (eq key ?\:) (null prefix))
+	     (if calc-mapping-dir
+		 (if (string-match "map$" msg)
+		     (setq calc-mapping-dir (if (equal calc-mapping-dir "c")
+						"" "c"))
+		   (setq calc-mapping-dir (if (equal calc-mapping-dir "d")
+					      "" "d")))
+	       (beep)))
+	    ((and (>= key ?0) (<= key ?9) (null prefix))
+	     (setq forcenargs (if (eq forcenargs (- key ?0)) nil (- key ?0)))
+	     (and nargs forcenargs (/= nargs forcenargs) (>= nargs 0)
+		  (error "Must be a %d-argument operator" nargs)))
+	    ((memq key '(?\$ ?\'))
+	     (let* ((arglist nil)
+		    (has-args nil)
+		    (record-entry nil)
+		    (expr (if (eq key ?\$)
+			      (progn
+				(setq calc-dollar-used 1)
+				(if calc-dollar-values
+				    (car calc-dollar-values)
+				  (error "Stack underflow")))
+			    (let* ((calc-dollar-values calc-arg-values)
+				   (calc-dollar-used 0)
+				   (calc-hashes-used 0)
+				   (func (calc-do-alg-entry "" "Function: ")))
+			      (setq record-entry t)
+			      (or (= (length func) 1)
+				  (error "Bad format"))
+			      (if (> calc-dollar-used 0)
+				  (progn
+				    (setq has-args calc-dollar-used
+					  arglist (calc-invent-args has-args))
+				    (math-multi-subst (car func)
+						      (reverse arglist)
+						      arglist))
+				(if (> calc-hashes-used 0)
+				    (setq has-args calc-hashes-used
+					  arglist (calc-invent-args has-args)))
+				(car func))))))
+	       (if (eq (car-safe expr) 'calcFunc-lambda)
+		   (setq oper (list "$" (- (length expr) 2) expr)
+			 done t)
+		 (or has-args
+		     (progn
+		       (calc-default-formula-arglist expr)
+		       (setq record-entry t
+			     arglist (sort arglist 'string-lessp))
+		       (if calc-verify-arglist
+			   (setq arglist (read-from-minibuffer
+					  "Function argument list: "
+					  (if arglist
+					      (prin1-to-string arglist)
+					    "()")
+					  minibuffer-local-map
+					  t)))
+		       (setq arglist (mapcar (function
+					      (lambda (x)
+						(list 'var
+						      x
+						      (intern
+						       (concat
+							"var-"
+							(symbol-name x))))))
+					     arglist))))
+		 (setq oper (list "$"
+				  (length arglist)
+				  (append '(calcFunc-lambda) arglist
+					  (list expr)))
+		       done t))
+	       (if record-entry
+		   (calc-record (nth 2 oper) "oper"))))
+	    ((setq oper (assq key (nth (if inv (if hyp 3 1) (if hyp 2 0))
+				       (if prefix
+					   (symbol-value
+					    (intern (format "calc-%c-oper-keys"
+							    prefix)))
+					 calc-oper-keys))))
+	     (if (eq (nth 1 oper) 'user)
+		 (let ((func (intern
+			      (completing-read "Function name: "
+					       obarray 'fboundp
+					       nil "calcFunc-"))))
+		   (if (or forcenargs nargs)
+		       (setq oper (list "z" (or forcenargs nargs) func)
+			     done t)
+		     (if (fboundp func)
+			 (let* ((defn (symbol-function func)))
+			   (and (symbolp defn)
+				(setq defn (symbol-function defn)))
+			   (if (eq (car-safe defn) 'lambda)
+			       (let ((args (nth 1 defn))
+				     (nargs 0))
+				 (while (not (memq (car args) '(&optional
+								&rest nil)))
+				   (setq nargs (1+ nargs)
+					 args (cdr args)))
+				 (setq oper (list "z" nargs func)
+				       done t))
+			     (error
+			      "Function is not suitable for this operation")))
+		       (message "Number of arguments: ")
+		       (let ((nargs (read-char)))
+			 (if (and (>= nargs ?0) (<= nargs ?9))
+			     (setq oper (list "z" (- nargs ?0) func)
+				   done t)
+			   (beep))))))
+	       (if (or (and (eq prefix ?v) (memq key '(?A ?I ?M ?O ?R ?U)))
+		       (and (eq prefix ?a) (eq key ?M)))
+		   (let* ((dir (cond ((and (equal calc-mapping-dir "")
+					   (string-match "map$" msg))
+				      (setq calc-mapping-dir "r")
+				      " rows")
+				     ((equal calc-mapping-dir "r") " rows")
+				     ((equal calc-mapping-dir "c") " columns")
+				     ((equal calc-mapping-dir "a") " across")
+				     ((equal calc-mapping-dir "d") " down")
+				     (t "")))
+			  (calc-mapping-dir (and (memq (nth 2 oper)
+						       '(calcFunc-map
+							 calcFunc-reduce
+							 calcFunc-rreduce))
+						 ""))
+			  (oper2 (calc-get-operator
+				  (format "%s%s, %s%s" msg dir
+					  (substring (symbol-name (nth 2 oper))
+						     9)
+					  (if (eq key ?I) " (mult)" ""))
+				  (cdr (assq (nth 2 oper)
+					     '((calcFunc-reduce  . 2)
+					       (calcFunc-rreduce . 2)
+					       (calcFunc-accum   . 2)
+					       (calcFunc-raccum  . 2)
+					       (calcFunc-nest    . 2)
+					       (calcFunc-anest   . 2)
+					       (calcFunc-fixp    . 2)
+					       (calcFunc-afixp   . 2))))))
+			  (oper3 (if (eq (nth 2 oper) 'calcFunc-inner)
+				     (calc-get-operator
+				      (format "%s%s, inner (add)" msg dir
+					      (substring
+					       (symbol-name (nth 2 oper))
+					       9)))
+				   '(0 0 0)))
+			  (args nil)
+			  (nargs (if (> (nth 1 oper) 0)
+				     (nth 1 oper)
+				   (car oper2)))
+			  (n nargs)
+			  (p calc-arg-values))
+		     (while (and p (> n 0))
+		       (or (math-expr-contains (nth 1 oper2) (car p))
+			   (math-expr-contains (nth 1 oper3) (car p))
+			   (setq args (nconc args (list (car p)))
+				 n (1- n)))
+		       (setq p (cdr p)))
+		     (setq oper (list "" nargs
+				      (append
+				       '(calcFunc-lambda)
+				       args
+				       (list (math-build-call
+					      (intern
+					       (concat
+						(symbol-name (nth 2 oper))
+						calc-mapping-dir))
+					      (cons (math-calcFunc-to-var
+						     (nth 1 oper2))
+						    (if (eq key ?I)
+							(cons
+							 (math-calcFunc-to-var
+							  (nth 1 oper3))
+							 args)
+						      args))))))
+			   done t))
+		 (setq done t))))
+	    (t (beep))))
+    (and nargs (>= nargs 0)
+	 (/= nargs (nth 1 oper))
+	 (error "Must be a %d-argument operator" nargs))
+    (append (if forcenargs
+		(cons forcenargs (cdr (cdr oper)))
+	      (cdr oper))
+	    (list
+	     (let ((name (concat (if inv "I" "") (if hyp "H" "")
+				 (if prefix (char-to-string prefix) "")
+				 (char-to-string key))))
+	       (if (> (length name) 3)
+		   (substring name 0 3)
+		 name)))))
+)
+(setq calc-verify-arglist t)
+(setq calc-mapping-dir nil)
+
+(defconst calc-oper-keys '( ( ( ?+ 2 calcFunc-add )
+			      ( ?- 2 calcFunc-sub )
+			      ( ?* 2 calcFunc-mul )
+			      ( ?/ 2 calcFunc-div )
+			      ( ?^ 2 calcFunc-pow )
+			      ( ?| 2 calcFunc-vconcat )
+			      ( ?% 2 calcFunc-mod )
+			      ( ?\\ 2 calcFunc-idiv )
+			      ( ?! 1 calcFunc-fact )
+			      ( ?& 1 calcFunc-inv )
+			      ( ?n 1 calcFunc-neg )
+			      ( ?x user )
+			      ( ?z user )
+			      ( ?A 1 calcFunc-abs )
+			      ( ?J 1 calcFunc-conj )
+			      ( ?G 1 calcFunc-arg )
+			      ( ?Q 1 calcFunc-sqrt )
+			      ( ?N 2 calcFunc-min )
+			      ( ?X 2 calcFunc-max )
+			      ( ?F 1 calcFunc-floor )
+			      ( ?R 1 calcFunc-round )
+			      ( ?S 1 calcFunc-sin )
+			      ( ?C 1 calcFunc-cos )
+			      ( ?T 1 calcFunc-tan )
+			      ( ?L 1 calcFunc-ln )
+			      ( ?E 1 calcFunc-exp )
+			      ( ?B 2 calcFunc-log ) )
+			    ( ( ?F 1 calcFunc-ceil )     ; inverse
+			      ( ?R 1 calcFunc-trunc )
+			      ( ?Q 1 calcFunc-sqr )
+			      ( ?S 1 calcFunc-arcsin )
+			      ( ?C 1 calcFunc-arccos )
+			      ( ?T 1 calcFunc-arctan )
+			      ( ?L 1 calcFunc-exp )
+			      ( ?E 1 calcFunc-ln )
+			      ( ?B 2 calcFunc-alog )
+			      ( ?^ 2 calcFunc-nroot )
+			      ( ?| 2 calcFunc-vconcatrev ) )
+			    ( ( ?F 1 calcFunc-ffloor )   ; hyperbolic
+			      ( ?R 1 calcFunc-fround )
+			      ( ?S 1 calcFunc-sinh )
+			      ( ?C 1 calcFunc-cosh )
+			      ( ?T 1 calcFunc-tanh )
+			      ( ?L 1 calcFunc-log10 )
+			      ( ?E 1 calcFunc-exp10 )
+			      ( ?| 2 calcFunc-append ) )
+			    ( ( ?F 1 calcFunc-fceil )    ; inverse-hyperbolic
+			      ( ?R 1 calcFunc-ftrunc )
+			      ( ?S 1 calcFunc-arcsinh )
+			      ( ?C 1 calcFunc-arccosh )
+			      ( ?T 1 calcFunc-arctanh )
+			      ( ?L 1 calcFunc-exp10 )
+			      ( ?E 1 calcFunc-log10 )
+			      ( ?| 2 calcFunc-appendrev ) )
+))
+(defconst calc-a-oper-keys '( ( ( ?a 3 calcFunc-apart )
+				( ?b 3 calcFunc-subst )
+				( ?c 2 calcFunc-collect )
+				( ?d 2 calcFunc-deriv )
+				( ?e 1 calcFunc-esimplify )
+				( ?f 2 calcFunc-factor )
+				( ?g 2 calcFunc-pgcd )
+				( ?i 2 calcFunc-integ )
+				( ?m 2 calcFunc-match )
+				( ?n 1 calcFunc-nrat )
+				( ?r 2 calcFunc-rewrite )
+				( ?s 1 calcFunc-simplify )
+				( ?t 3 calcFunc-taylor )
+				( ?x 1 calcFunc-expand )
+				( ?M 2 calcFunc-mapeq )
+				( ?N 3 calcFunc-minimize )
+				( ?P 2 calcFunc-roots )
+				( ?R 3 calcFunc-root )
+				( ?S 2 calcFunc-solve )
+				( ?T 4 calcFunc-table )
+				( ?X 3 calcFunc-maximize )
+				( ?= 2 calcFunc-eq )
+				( ?\# 2 calcFunc-neq )
+				( ?< 2 calcFunc-lt )
+				( ?> 2 calcFunc-gt )
+				( ?\[ 2 calcFunc-leq )
+				( ?\] 2 calcFunc-geq )
+				( ?{ 2 calcFunc-in )
+				( ?! 1 calcFunc-lnot )
+				( ?& 2 calcFunc-land )
+				( ?\| 2 calcFunc-lor )
+				( ?: 3 calcFunc-if )
+				( ?. 2 calcFunc-rmeq )
+				( ?+ 4 calcFunc-sum )
+				( ?- 4 calcFunc-asum )
+				( ?* 4 calcFunc-prod )
+				( ?_ 2 calcFunc-subscr )
+				( ?\\ 2 calcFunc-pdiv )
+				( ?% 2 calcFunc-prem )
+				( ?/ 2 calcFunc-pdivrem ) )
+			      ( ( ?m 2 calcFunc-matchnot )
+				( ?M 2 calcFunc-mapeqr )
+				( ?S 2 calcFunc-finv ) )
+			      ( ( ?d 2 calcFunc-tderiv )
+				( ?f 2 calcFunc-factors )
+				( ?M 2 calcFunc-mapeqp )
+				( ?N 3 calcFunc-wminimize )
+				( ?R 3 calcFunc-wroot )
+				( ?S 2 calcFunc-fsolve )
+				( ?X 3 calcFunc-wmaximize )
+				( ?/ 2 calcFunc-pdivide ) )
+			      ( ( ?S 2 calcFunc-ffinv ) )
+))
+(defconst calc-b-oper-keys '( ( ( ?a 2 calcFunc-and )
+				( ?o 2 calcFunc-or )
+				( ?x 2 calcFunc-xor )
+				( ?d 2 calcFunc-diff )
+				( ?n 1 calcFunc-not )
+				( ?c 1 calcFunc-clip )
+				( ?l 2 calcFunc-lsh )
+				( ?r 2 calcFunc-rsh )
+				( ?L 2 calcFunc-ash )
+				( ?R 2 calcFunc-rash )
+				( ?t 2 calcFunc-rot )
+				( ?p 1 calcFunc-vpack )
+				( ?u 1 calcFunc-vunpack )
+				( ?D 4 calcFunc-ddb )
+				( ?F 3 calcFunc-fv )
+				( ?I 1 calcFunc-irr )
+				( ?M 3 calcFunc-pmt )
+				( ?N 2 calcFunc-npv )
+				( ?P 3 calcFunc-pv )
+				( ?S 3 calcFunc-sln )
+				( ?T 3 calcFunc-rate )
+				( ?Y 4 calcFunc-syd )
+				( ?\# 3 calcFunc-nper )
+				( ?\% 2 calcFunc-relch ) )
+			      ( ( ?F 3 calcFunc-fvb )
+				( ?I 1 calcFunc-irrb )
+				( ?M 3 calcFunc-pmtb )
+				( ?N 2 calcFunc-npvb )
+				( ?P 3 calcFunc-pvb )
+				( ?T 3 calcFunc-rateb )
+				( ?\# 3 calcFunc-nperb ) )
+			      ( ( ?F 3 calcFunc-fvl )
+				( ?M 3 calcFunc-pmtl )
+				( ?P 3 calcFunc-pvl )
+				( ?T 3 calcFunc-ratel )
+				( ?\# 3 calcFunc-nperl ) )
+))
+(defconst calc-c-oper-keys '( ( ( ?d 1 calcFunc-deg )
+				( ?r 1 calcFunc-rad )
+				( ?h 1 calcFunc-hms )
+				( ?f 1 calcFunc-float )
+				( ?F 1 calcFunc-frac ) )
+))
+(defconst calc-f-oper-keys '( ( ( ?b 2 calcFunc-beta )
+				( ?e 1 calcFunc-erf )
+				( ?g 1 calcFunc-gamma )
+				( ?h 2 calcFunc-hypot )
+				( ?i 1 calcFunc-im )
+				( ?j 2 calcFunc-besJ )
+				( ?n 2 calcFunc-min )
+				( ?r 1 calcFunc-re )
+				( ?s 1 calcFunc-sign )
+				( ?x 2 calcFunc-max )
+				( ?y 2 calcFunc-besY )
+				( ?A 1 calcFunc-abssqr )
+				( ?B 3 calcFunc-betaI )
+				( ?E 1 calcFunc-expm1 )
+				( ?G 2 calcFunc-gammaP )
+				( ?I 2 calcFunc-ilog )
+				( ?L 1 calcFunc-lnp1 )
+				( ?M 1 calcFunc-mant )
+				( ?Q 1 calcFunc-isqrt )
+				( ?S 1 calcFunc-scf )
+				( ?T 2 calcFunc-arctan2 )
+				( ?X 1 calcFunc-xpon )
+				( ?\[ 2 calcFunc-decr )
+				( ?\] 2 calcFunc-incr ) )
+			      ( ( ?e 1 calcFunc-erfc )
+				( ?E 1 calcFunc-lnp1 )
+				( ?G 2 calcFunc-gammaQ )
+				( ?L 1 calcFunc-expm1 ) )
+			      ( ( ?B 3 calcFunc-betaB )
+				( ?G 2 calcFunc-gammag) )
+			      ( ( ?G 2 calcFunc-gammaG ) )
+))
+(defconst calc-k-oper-keys '( ( ( ?b 1 calcFunc-bern )
+				( ?c 2 calcFunc-choose )
+				( ?d 1 calcFunc-dfact )
+				( ?e 1 calcFunc-euler )
+				( ?f 1 calcFunc-prfac )
+				( ?g 2 calcFunc-gcd )
+				( ?h 2 calcFunc-shuffle )
+				( ?l 2 calcFunc-lcm )
+				( ?m 1 calcFunc-moebius )
+				( ?n 1 calcFunc-nextprime )
+				( ?r 1 calcFunc-random )
+				( ?s 2 calcFunc-stir1 )
+				( ?t 1 calcFunc-totient )
+				( ?B 3 calcFunc-utpb )
+				( ?C 2 calcFunc-utpc )
+				( ?F 3 calcFunc-utpf )
+				( ?N 3 calcFunc-utpn )
+				( ?P 2 calcFunc-utpp )
+				( ?T 2 calcFunc-utpt ) )
+			      ( ( ?n 1 calcFunc-prevprime )
+				( ?B 3 calcFunc-ltpb )
+				( ?C 2 calcFunc-ltpc )
+				( ?F 3 calcFunc-ltpf )
+				( ?N 3 calcFunc-ltpn )
+				( ?P 2 calcFunc-ltpp )
+				( ?T 2 calcFunc-ltpt ) )
+			      ( ( ?b 2 calcFunc-bern )
+				( ?c 2 calcFunc-perm )
+				( ?e 2 calcFunc-euler )
+				( ?s 2 calcFunc-stir2 ) )
+))
+(defconst calc-s-oper-keys '( ( ( ?: 2 calcFunc-assign )
+				( ?= 1 calcFunc-evalto ) )
+))
+(defconst calc-t-oper-keys '( ( ( ?C 3 calcFunc-tzconv )
+				( ?D 1 calcFunc-date )
+				( ?I 2 calcFunc-incmonth )
+				( ?J 1 calcFunc-julian )
+				( ?M 1 calcFunc-newmonth )
+				( ?W 1 calcFunc-newweek )
+				( ?U 1 calcFunc-unixtime )
+				( ?Y 1 calcFunc-newyear ) )
+))
+(defconst calc-u-oper-keys '( ( ( ?C 2 calcFunc-vcov )
+				( ?G 1 calcFunc-vgmean )
+				( ?M 1 calcFunc-vmean )
+				( ?N 1 calcFunc-vmin )
+				( ?S 1 calcFunc-vsdev )
+				( ?X 1 calcFunc-vmax ) )
+			      ( ( ?C 2 calcFunc-vpcov )
+				( ?M 1 calcFunc-vmeane )
+				( ?S 1 calcFunc-vpsdev ) )
+			      ( ( ?C 2 calcFunc-vcorr )
+				( ?G 1 calcFunc-agmean )
+				( ?M 1 calcFunc-vmedian )
+				( ?S 1 calcFunc-vvar ) )
+			      ( ( ?M 1 calcFunc-vhmean )
+				( ?S 1 calcFunc-vpvar ) )
+))
+(defconst calc-v-oper-keys '( ( ( ?a 2 calcFunc-arrange )
+				( ?b 2 calcFunc-cvec )
+				( ?c 2 calcFunc-mcol )
+				( ?d 2 calcFunc-diag )
+				( ?e 2 calcFunc-vexp )
+				( ?f 2 calcFunc-find )
+				( ?h 1 calcFunc-head )
+				( ?k 2 calcFunc-cons )
+				( ?l 1 calcFunc-vlen )
+				( ?m 2 calcFunc-vmask )
+				( ?n 1 calcFunc-rnorm )
+				( ?p 2 calcFunc-pack )
+				( ?r 2 calcFunc-mrow )
+				( ?s 3 calcFunc-subvec )
+				( ?t 1 calcFunc-trn )
+				( ?u 1 calcFunc-unpack )
+				( ?v 1 calcFunc-rev )
+				( ?x 1 calcFunc-index )
+				( ?A 1 calcFunc-apply )
+				( ?C 1 calcFunc-cross )
+				( ?D 1 calcFunc-det )
+				( ?E 1 calcFunc-venum )
+				( ?F 1 calcFunc-vfloor )
+				( ?G 1 calcFunc-grade )
+				( ?H 2 calcFunc-histogram )
+				( ?I 2 calcFunc-inner )
+				( ?L 1 calcFunc-lud )
+				( ?M 0 calcFunc-map )
+				( ?N 1 calcFunc-cnorm )
+				( ?O 2 calcFunc-outer )
+				( ?R 1 calcFunc-reduce )
+				( ?S 1 calcFunc-sort )
+				( ?T 1 calcFunc-tr )
+				( ?U 1 calcFunc-accum )
+				( ?V 2 calcFunc-vunion )
+				( ?X 2 calcFunc-vxor )
+				( ?- 2 calcFunc-vdiff )
+				( ?^ 2 calcFunc-vint )
+				( ?~ 1 calcFunc-vcompl )
+				( ?# 1 calcFunc-vcard )
+				( ?: 1 calcFunc-vspan )
+				( ?+ 1 calcFunc-rdup ) )
+			      ( ( ?h 1 calcFunc-tail )
+				( ?s 3 calcFunc-rsubvec )
+				( ?G 1 calcFunc-rgrade )
+				( ?R 1 calcFunc-rreduce )
+				( ?S 1 calcFunc-rsort )
+				( ?U 1 calcFunc-raccum ) )
+			      ( ( ?e 3 calcFunc-vexp )
+				( ?h 1 calcFunc-rhead )
+				( ?k 2 calcFunc-rcons )
+				( ?H 3 calcFunc-histogram )
+				( ?R 2 calcFunc-nest )
+				( ?U 2 calcFunc-anest ) )
+			      ( ( ?h 1 calcFunc-rtail )
+				( ?R 1 calcFunc-fixp )
+				( ?U 1 calcFunc-afixp ) )
+))
+
+
+;;; Convert a variable name (as a formula) into a like-looking function name.
+(defun math-var-to-calcFunc (f)
+  (if (eq (car-safe f) 'var)
+      (if (fboundp (nth 2 f))
+	  (nth 2 f)
+	(intern (concat "calcFunc-" (symbol-name (nth 1 f)))))
+    (if (memq (car-safe f) '(lambda calcFunc-lambda))
+	f
+      (math-reject-arg f "*Expected a function name")))
+)
+
+;;; Convert a function name into a like-looking variable name formula.
+(defun math-calcFunc-to-var (f)
+  (if (symbolp f)
+      (let* ((func (or (cdr (assq f '( ( + . calcFunc-add )
+				       ( - . calcFunc-sub )
+				       ( * . calcFunc-mul )
+				       ( / . calcFunc-div )
+				       ( ^ . calcFunc-pow )
+				       ( % . calcFunc-mod )
+				       ( neg . calcFunc-neg )
+				       ( | . calcFunc-vconcat ) )))
+		       f))
+	     (base (if (string-match "\\`calcFunc-\\(.+\\)\\'"
+				     (symbol-name func))
+		       (math-match-substring (symbol-name func) 1)
+		     (symbol-name func))))
+	(list 'var
+	      (intern base)
+	      (intern (concat "var-" base))))
+    f)
+)
+
+;;; Expand a function call using "lambda" notation.
+(defun math-build-call (f args)
+  (if (eq (car-safe f) 'calcFunc-lambda)
+      (if (= (length args) (- (length f) 2))
+	  (math-multi-subst (nth (1- (length f)) f) (cdr f) args)
+	(calc-record-why "*Wrong number of arguments" f)
+	(cons 'calcFunc-call (cons (math-calcFunc-to-var f) args)))
+    (if (and (eq f 'calcFunc-neg)
+	     (= (length args) 1))
+	(list 'neg (car args))
+      (let ((func (assq f '( ( calcFunc-add . + )
+			     ( calcFunc-sub . - )
+			     ( calcFunc-mul . * )
+			     ( calcFunc-div . / )
+			     ( calcFunc-pow . ^ )
+			     ( calcFunc-mod . % )
+			     ( calcFunc-vconcat . | ) ))))
+	(if (and func (= (length args) 2))
+	    (cons (cdr func) args)
+	  (cons f args)))))
+)
+
+;;; Do substitutions in parallel to avoid crosstalk.
+(defun math-multi-subst (expr olds news)
+  (let ((args nil)
+	temp)
+    (while (and olds news)
+      (setq args (cons (cons (car olds) (car news)) args)
+	    olds (cdr olds)
+	    news (cdr news)))
+    (math-multi-subst-rec expr))
+)
+
+(defun math-multi-subst-rec (expr)
+  (cond ((setq temp (assoc expr args)) (cdr temp))
+	((Math-primp expr) expr)
+	((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2))
+	 (let ((new (list (car expr)))
+	       (args args))
+	   (while (cdr (setq expr (cdr expr)))
+	     (setq new (cons (car expr) new))
+	     (if (assoc (car expr) args)
+		 (setq args (cons (cons (car expr) (car expr)) args))))
+	   (nreverse (cons (math-multi-subst-rec (car expr)) new))))
+	(t
+	 (cons (car expr)
+	       (mapcar 'math-multi-subst-rec (cdr expr)))))
+)
+
+(defun calcFunc-call (f &rest args)
+  (setq args (math-build-call (math-var-to-calcFunc f) args))
+  (if (eq (car-safe args) 'calcFunc-call)
+      args
+    (math-normalize args))
+)
+
+(defun calcFunc-apply (f args)
+  (or (Math-vectorp args)
+      (math-reject-arg args 'vectorp))
+  (apply 'calcFunc-call (cons f (cdr args)))
+)
+
+
+
+
+;;; Map a function over a vector symbolically. [Public]
+(defun math-symb-map (f mode args)
+  (let* ((func (math-var-to-calcFunc f))
+	 (nargs (length args))
+	 (ptrs (vconcat args))
+	 (vflags (make-vector nargs nil))
+	 (heads '(vec))
+	 (head nil)
+	 (vec nil)
+	 (i -1)
+	 (math-working-step 0)
+	 (math-working-step-2 nil)
+	 len cols obj expr)
+    (if (eq mode 'eqn)
+	(setq mode 'elems
+	      heads '(calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt
+				  calcFunc-leq calcFunc-geq))
+      (while (and (< (setq i (1+ i)) nargs)
+		  (not (math-matrixp (aref ptrs i)))))
+      (if (< i nargs)
+	  (if (eq mode 'elems)
+	      (setq func (list 'lambda '(&rest x)
+			       (list 'math-symb-map
+				     (list 'quote f) '(quote elems) 'x))
+		    mode 'rows)
+	    (if (eq mode 'cols)
+		(while (< i nargs)
+		  (if (math-matrixp (aref ptrs i))
+		      (aset ptrs i (math-transpose (aref ptrs i))))
+		  (setq i (1+ i)))))
+	(setq mode 'elems))
+      (setq i -1))
+    (while (< (setq i (1+ i)) nargs)
+      (setq obj (aref ptrs i))
+      (if (and (memq (car-safe obj) heads)
+	       (or (eq mode 'elems)
+		   (math-matrixp obj)))
+	  (progn
+	    (aset vflags i t)
+	    (if head
+		(if (cdr heads)
+		    (setq head (nth
+				(aref (aref [ [0 1 2 3 4 5]
+					      [1 1 2 3 2 3]
+					      [2 2 2 1 2 1]
+					      [3 3 1 3 1 3]
+					      [4 2 2 1 4 1]
+					      [5 3 1 3 1 5] ]
+					    (- 6 (length (memq head heads))))
+				      (- 6 (length (memq (car obj) heads))))
+				heads)))
+	      (setq head (car obj)))
+	    (if len
+		(or (= (length obj) len)
+		    (math-dimension-error))
+	      (setq len (length obj))))))
+    (or len
+	(if (= nargs 1)
+	    (math-reject-arg (aref ptrs 0) 'vectorp)
+	  (math-reject-arg nil "At least one argument must be a vector")))
+    (setq math-working-step-2 (1- len))
+    (while (> (setq len (1- len)) 0)
+      (setq expr nil
+	    i -1)
+      (while (< (setq i (1+ i)) nargs)
+	(if (aref vflags i)
+	    (progn
+	      (aset ptrs i (cdr (aref ptrs i)))
+	      (setq expr (nconc expr (list (car (aref ptrs i))))))
+	  (setq expr (nconc expr (list (aref ptrs i))))))
+      (setq math-working-step (1+ math-working-step)
+	    vec (cons (math-normalize (math-build-call func expr)) vec)))
+    (setq vec (cons head (nreverse vec)))
+    (if (and (eq mode 'cols) (math-matrixp vec))
+	(math-transpose vec)
+      vec))
+)
+
+(defun calcFunc-map (func &rest args)
+  (math-symb-map func 'elems args)
+)
+
+(defun calcFunc-mapr (func &rest args)
+  (math-symb-map func 'rows args)
+)
+
+(defun calcFunc-mapc (func &rest args)
+  (math-symb-map func 'cols args)
+)
+
+(defun calcFunc-mapa (func arg)
+  (if (math-matrixp arg)
+      (math-symb-map func 'elems (cdr (math-transpose arg)))
+    (math-symb-map func 'elems arg))
+)
+
+(defun calcFunc-mapd (func arg)
+  (if (math-matrixp arg)
+      (math-symb-map func 'elems (cdr arg))
+    (math-symb-map func 'elems arg))
+)
+
+(defun calcFunc-mapeq (func &rest args)
+  (if (and (or (equal func '(var mul var-mul))
+	       (equal func '(var div var-div)))
+	   (= (length args) 2))
+      (if (math-negp (car args))
+	  (let ((func (nth 1 (assq (car-safe (nth 1 args))
+				   calc-tweak-eqn-table))))
+	    (and func (setq args (list (car args)
+				       (cons func (cdr (nth 1 args)))))))
+	(if (math-negp (nth 1 args))
+	    (let ((func (nth 1 (assq (car-safe (car args))
+				     calc-tweak-eqn-table))))
+	      (and func (setq args (list (cons func (cdr (car args)))
+					 (nth 1 args))))))))
+  (if (or (and (equal func '(var div var-div))
+	       (assq (car-safe (nth 1 args)) calc-tweak-eqn-table))
+	  (equal func '(var neg var-neg))
+	  (equal func '(var inv var-inv)))
+      (apply 'calcFunc-mapeqr func args)
+    (apply 'calcFunc-mapeqp func args))
+)
+
+(defun calcFunc-mapeqr (func &rest args)
+  (setq args (mapcar (function (lambda (x)
+				 (let ((func (assq (car-safe x)
+						   calc-tweak-eqn-table)))
+				   (if func
+				       (cons (nth 1 func) (cdr x))
+				     x))))
+		     args))
+  (apply 'calcFunc-mapeqp func args)
+)
+
+(defun calcFunc-mapeqp (func &rest args)
+  (if (or (and (memq (car-safe (car args)) '(calcFunc-lt calcFunc-leq))
+	       (memq (car-safe (nth 1 args)) '(calcFunc-gt calcFunc-geq)))
+	  (and (memq (car-safe (car args)) '(calcFunc-gt calcFunc-geq))
+	       (memq (car-safe (nth 1 args)) '(calcFunc-lt calcFunc-leq))))
+      (setq args (cons (car args)
+		       (cons (list (nth 1 (assq (car (nth 1 args))
+						calc-tweak-eqn-table))
+				   (nth 2 (nth 1 args))
+				   (nth 1 (nth 1 args)))
+			     (cdr (cdr args))))))
+  (math-symb-map func 'eqn args)
+)
+
+
+
+;;; Reduce a function over a vector symbolically. [Public]
+(defun calcFunc-reduce (func vec)
+  (if (math-matrixp vec)
+      (let (expr row)
+	(setq func (math-var-to-calcFunc func))
+	(while (setq vec (cdr vec))
+	  (setq row (car vec))
+	  (while (setq row (cdr row))
+	    (setq expr (if expr
+			   (if (Math-numberp expr)
+			       (math-normalize
+				(math-build-call func (list expr (car row))))
+			     (math-build-call func (list expr (car row))))
+			 (car row)))))
+	(math-normalize expr))
+    (calcFunc-reducer func vec))
+)
+
+(defun calcFunc-rreduce (func vec)
+  (if (math-matrixp vec)
+      (let (expr row)
+	(setq func (math-var-to-calcFunc func)
+	      vec (reverse (cdr vec)))
+	(while vec
+	  (setq row (reverse (cdr (car vec))))
+	  (while row
+	    (setq expr (if expr
+			   (math-build-call func (list (car row) expr))
+			 (car row))
+		  row (cdr row)))
+	  (setq vec (cdr vec)))
+	(math-normalize expr))
+    (calcFunc-rreducer func vec))
+)
+
+(defun calcFunc-reducer (func vec)
+  (setq func (math-var-to-calcFunc func))
+  (or (math-vectorp vec)
+      (math-reject-arg vec 'vectorp))
+  (let ((expr (car (setq vec (cdr vec)))))
+    (if expr
+	(progn
+	  (condition-case err
+	      (and (symbolp func)
+		   (let ((lfunc (or (cdr (assq func
+					       '( (calcFunc-add . math-add)
+						  (calcFunc-sub . math-sub)
+						  (calcFunc-mul . math-mul)
+						  (calcFunc-div . math-div)
+						  (calcFunc-pow . math-pow)
+						  (calcFunc-mod . math-mod)
+						  (calcFunc-vconcat .
+						   math-concat) )))
+				    lfunc)))
+		     (while (cdr vec)
+		       (setq expr (funcall lfunc expr (nth 1 vec))
+			     vec (cdr vec)))))
+	    (error nil))
+	  (while (setq vec (cdr vec))
+	    (setq expr (math-build-call func (list expr (car vec)))))
+	  (math-normalize expr))
+      (or (math-identity-value func)
+	  (math-reject-arg vec "*Vector is empty"))))
+)
+
+(defun math-identity-value (func)
+  (cdr (assq func '( (calcFunc-add . 0) (calcFunc-sub . 0)
+		     (calcFunc-mul . 1) (calcFunc-div . 1)
+		     (calcFunc-idiv . 1) (calcFunc-fdiv . 1)
+		     (calcFunc-min . (var inf var-inf))
+		     (calcFunc-max . (neg (var inf var-inf)))
+		     (calcFunc-vconcat . (vec))
+		     (calcFunc-append . (vec)) )))
+)
+
+(defun calcFunc-rreducer (func vec)
+  (setq func (math-var-to-calcFunc func))
+  (or (math-vectorp vec)
+      (math-reject-arg vec 'vectorp))
+  (if (eq func 'calcFunc-sub)   ; do this in a way that looks nicer
+      (let ((expr (car (setq vec (cdr vec)))))
+	(if expr
+	    (progn
+	      (while (setq vec (cdr vec))
+		(setq expr (math-build-call func (list expr (car vec)))
+		      func (if (eq func 'calcFunc-sub)
+			       'calcFunc-add 'calcFunc-sub)))
+	      (math-normalize expr))
+	  0))
+    (let ((expr (car (setq vec (reverse (cdr vec))))))
+      (if expr
+	  (progn
+	    (while (setq vec (cdr vec))
+	      (setq expr (math-build-call func (list (car vec) expr))))
+	    (math-normalize expr))
+	(or (math-identity-value func)
+	    (math-reject-arg vec "*Vector is empty")))))
+)
+
+(defun calcFunc-reducec (func vec)
+  (if (math-matrixp vec)
+      (calcFunc-reducer func (math-transpose vec))
+    (calcFunc-reducer func vec))
+)
+
+(defun calcFunc-rreducec (func vec)
+  (if (math-matrixp vec)
+      (calcFunc-rreducer func (math-transpose vec))
+    (calcFunc-rreducer func vec))
+)
+
+(defun calcFunc-reducea (func vec)
+  (if (math-matrixp vec)
+      (cons 'vec
+	    (mapcar (function (lambda (x) (calcFunc-reducer func x)))
+		    (cdr vec)))
+    (calcFunc-reducer func vec))
+)
+
+(defun calcFunc-rreducea (func vec)
+  (if (math-matrixp vec)
+      (cons 'vec
+	    (mapcar (function (lambda (x) (calcFunc-rreducer func x)))
+		    (cdr vec)))
+    (calcFunc-rreducer func vec))
+)
+
+(defun calcFunc-reduced (func vec)
+  (if (math-matrixp vec)
+      (cons 'vec
+	    (mapcar (function (lambda (x) (calcFunc-reducer func x)))
+		    (cdr (math-transpose vec))))
+    (calcFunc-reducer func vec))
+)
+
+(defun calcFunc-rreduced (func vec)
+  (if (math-matrixp vec)
+      (cons 'vec
+	    (mapcar (function (lambda (x) (calcFunc-rreducer func x)))
+		    (cdr (math-transpose vec))))
+    (calcFunc-rreducer func vec))
+)
+
+(defun calcFunc-accum (func vec)
+  (setq func (math-var-to-calcFunc func))
+  (or (math-vectorp vec)
+      (math-reject-arg vec 'vectorp))
+  (let* ((expr (car (setq vec (cdr vec))))
+	 (res (list 'vec expr)))
+    (or expr
+	(math-reject-arg vec "*Vector is empty"))
+    (while (setq vec (cdr vec))
+      (setq expr (math-build-call func (list expr (car vec)))
+	    res (nconc res (list expr))))
+    (math-normalize res))
+)
+
+(defun calcFunc-raccum (func vec)
+  (setq func (math-var-to-calcFunc func))
+  (or (math-vectorp vec)
+      (math-reject-arg vec 'vectorp))
+  (let* ((expr (car (setq vec (reverse (cdr vec)))))
+	 (res (list expr)))
+    (or expr
+	(math-reject-arg vec "*Vector is empty"))
+    (while (setq vec (cdr vec))
+      (setq expr (math-build-call func (list (car vec) expr))
+	    res (cons (list expr) res)))
+    (math-normalize (cons 'vec res)))
+)
+
+
+(defun math-nest-calls (func base iters accum tol)
+  (or (symbolp tol)
+      (if (math-realp tol)
+	  (or (math-numberp base) (math-reject-arg base 'numberp))
+	(math-reject-arg tol 'realp)))
+  (setq func (math-var-to-calcFunc func))
+  (or (null iters)
+      (if (equal iters '(var inf var-inf))
+	  (setq iters nil)
+	(progn
+	  (if (math-messy-integerp iters)
+	      (setq iters (math-trunc iters)))
+	  (or (integerp iters) (math-reject-arg iters 'fixnump))
+	  (or (not tol) (natnump iters) (math-reject-arg iters 'fixnatnump))
+	  (if (< iters 0)
+	      (let* ((dummy '(var DummyArg var-DummyArg))
+		     (dummy2 '(var DummyArg2 var-DummyArg2))
+		     (finv (math-solve-for (math-build-call func (list dummy2))
+					   dummy dummy2 nil)))
+		(or finv (math-reject-arg nil "*Unable to find an inverse"))
+		(if (and (= (length finv) 2)
+			 (equal (nth 1 finv) dummy))
+		    (setq func (car finv))
+		  (setq func (list 'calcFunc-lambda dummy finv)))
+		(setq iters (- iters)))))))
+  (math-with-extra-prec 1
+    (let ((value base)
+	  (ovalue nil)
+	  (avalues (list base))
+	  (math-working-step 0)
+	  (math-working-step-2 iters))
+      (while (and (or (null iters)
+		      (>= (setq iters (1- iters)) 0))
+		  (or (null tol)
+		      (null ovalue)
+		      (if (eq tol t)
+			  (not (if (and (Math-numberp value)
+					(Math-numberp ovalue))
+				   (math-nearly-equal value ovalue)
+				 (Math-equal value ovalue)))
+			(if (math-numberp value)
+			    (Math-lessp tol (math-abs (math-sub value ovalue)))
+			  (math-reject-arg value 'numberp)))))
+	(setq ovalue value
+	      math-working-step (1+ math-working-step)
+	      value (math-normalize (math-build-call func (list value))))
+	(if accum
+	    (setq avalues (cons value avalues))))
+      (if accum
+	  (cons 'vec (nreverse avalues))
+	value)))
+)
+
+(defun calcFunc-nest (func base iters)
+  (math-nest-calls func base iters nil nil)
+)
+
+(defun calcFunc-anest (func base iters)
+  (math-nest-calls func base iters t nil)
+)
+
+(defun calcFunc-fixp (func base &optional iters tol)
+  (math-nest-calls func base iters nil (or tol t))
+)
+
+(defun calcFunc-afixp (func base &optional iters tol)
+  (math-nest-calls func base iters t (or tol t))
+)
+
+
+(defun calcFunc-outer (func a b)
+  (or (math-vectorp a) (math-reject-arg a 'vectorp))
+  (or (math-vectorp b) (math-reject-arg b 'vectorp))
+  (setq func (math-var-to-calcFunc func))
+  (let ((mat nil))
+    (while (setq a (cdr a))
+      (setq mat (cons (cons 'vec
+			    (mapcar (function (lambda (x)
+						(math-build-call func
+								 (list (car a)
+								       x))))
+				    (cdr b)))
+		      mat)))
+    (math-normalize (cons 'vec (nreverse mat))))
+)
+
+
+(defun calcFunc-inner (mul-func add-func a b)
+  (or (math-vectorp a) (math-reject-arg a 'vectorp))
+  (or (math-vectorp b) (math-reject-arg b 'vectorp))
+  (if (math-matrixp a)
+      (if (math-matrixp b)
+	  (if (= (length (nth 1 a)) (length b))
+	      (math-inner-mats a b)
+	    (math-dimension-error))
+	(if (= (length (nth 1 a)) 2)
+	    (if (= (length a) (length b))
+		(math-inner-mats a (list 'vec b))
+	      (math-dimension-error))
+	  (if (= (length (nth 1 a)) (length b))
+	      (math-mat-col (math-inner-mats a (math-col-matrix b))
+			    1)
+	    (math-dimension-error))))
+    (if (math-matrixp b)
+	(nth 1 (math-inner-mats (list 'vec a) b))
+      (calcFunc-reduce add-func (calcFunc-map mul-func a b))))
+)
+
+(defun math-inner-mats (a b)
+  (let ((mat nil)
+	(cols (length (nth 1 b)))
+	row col ap bp accum)
+    (while (setq a (cdr a))
+      (setq col cols
+	    row nil)
+      (while (> (setq col (1- col)) 0)
+	(setq row (cons (calcFunc-reduce add-func
+					 (calcFunc-map mul-func
+						       (car a)
+						       (math-mat-col b col)))
+			row)))
+      (setq mat (cons (cons 'vec row) mat)))
+    (cons 'vec (nreverse mat)))
+)
+
+
+