/[emacs]/emacs/lisp/calc/calc-map.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-map.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by uid65629, Sun Feb 8 22:39:28 2004 UTC revision 1.9 by jpb, Fri Nov 26 22:36:49 2004 UTC
# Line 3  Line 3 
3  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2004 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2004 Free Software Foundation, Inc.
4    
5  ;; Author: David Gillespie <daveg@synaptics.com>  ;; Author: David Gillespie <daveg@synaptics.com>
6  ;; Maintainers: D. Goel <deego@gnufans.org>  ;; Maintainer: Jay Belanger <belanger@truman.edu>
 ;;              Colin Walters <walters@debian.org>  
7    
8  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
9    
# Line 802  Line 801 
801            (cons f args))))))            (cons f args))))))
802    
803  ;;; Do substitutions in parallel to avoid crosstalk.  ;;; Do substitutions in parallel to avoid crosstalk.
804    
805    ;; The variables math-ms-temp and math-ms-args are local to
806    ;; math-multi-subst, but are used by math-multi-subst-rec, which
807    ;; is called by math-multi-subst.
808    (defvar math-ms-temp)
809    (defvar math-ms-args)
810    
811  (defun math-multi-subst (expr olds news)  (defun math-multi-subst (expr olds news)
812    (let ((args nil)    (let ((math-ms-args nil)
813          temp)          math-ms-temp)
814      (while (and olds news)      (while (and olds news)
815        (setq args (cons (cons (car olds) (car news)) args)        (setq math-ms-args (cons (cons (car olds) (car news)) math-ms-args)
816              olds (cdr olds)              olds (cdr olds)
817              news (cdr news)))              news (cdr news)))
818      (math-multi-subst-rec expr)))      (math-multi-subst-rec expr)))
819    
820  (defun math-multi-subst-rec (expr)  (defun math-multi-subst-rec (expr)
821    (cond ((setq temp (assoc expr args)) (cdr temp))    (cond ((setq math-ms-temp (assoc expr math-ms-args))
822             (cdr math-ms-temp))
823          ((Math-primp expr) expr)          ((Math-primp expr) expr)
824          ((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2))          ((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2))
825           (let ((new (list (car expr)))           (let ((new (list (car expr)))
826                 (args args))                 (math-ms-args math-ms-args))
827             (while (cdr (setq expr (cdr expr)))             (while (cdr (setq expr (cdr expr)))
828               (setq new (cons (car expr) new))               (setq new (cons (car expr) new))
829               (if (assoc (car expr) args)               (if (assoc (car expr) math-ms-args)
830                   (setq args (cons (cons (car expr) (car expr)) args))))                   (setq math-ms-args (cons (cons (car expr) (car expr))
831                                              math-ms-args))))
832             (nreverse (cons (math-multi-subst-rec (car expr)) new))))             (nreverse (cons (math-multi-subst-rec (car expr)) new))))
833          (t          (t
834           (cons (car expr)           (cons (car expr)
# Line 1033  Line 1041 
1041                                                    (calcFunc-mod . math-mod)                                                    (calcFunc-mod . math-mod)
1042                                                    (calcFunc-vconcat .                                                    (calcFunc-vconcat .
1043                                                     math-concat) )))                                                     math-concat) )))
1044                                      lfunc)))                                      func)))
1045                       (while (cdr vec)                       (while (cdr vec)
1046                         (setq expr (funcall lfunc expr (nth 1 vec))                         (setq expr (funcall lfunc expr (nth 1 vec))
1047                               vec (cdr vec)))))                               vec (cdr vec)))))
# Line 1222  Line 1230 
1230      (math-normalize (cons 'vec (nreverse mat)))))      (math-normalize (cons 'vec (nreverse mat)))))
1231    
1232    
1233  (defun calcFunc-inner (mul-func add-func a b)  ;; The variables math-inner-mul-func and math-inner-add-func are
1234    ;; local to calcFunc-inner, but are used by math-inner-mats,
1235    ;; which is called by math-inner-mats.
1236    (defvar math-inner-mul-func)
1237    (defvar math-inner-add-func)
1238    
1239    (defun calcFunc-inner (math-inner-mul-func math-inner-add-func a b)
1240    (or (math-vectorp a) (math-reject-arg a 'vectorp))    (or (math-vectorp a) (math-reject-arg a 'vectorp))
1241    (or (math-vectorp b) (math-reject-arg b 'vectorp))    (or (math-vectorp b) (math-reject-arg b 'vectorp))
1242    (if (math-matrixp a)    (if (math-matrixp a)
# Line 1240  Line 1254 
1254              (math-dimension-error))))              (math-dimension-error))))
1255      (if (math-matrixp b)      (if (math-matrixp b)
1256          (nth 1 (math-inner-mats (list 'vec a) b))          (nth 1 (math-inner-mats (list 'vec a) b))
1257        (calcFunc-reduce add-func (calcFunc-map mul-func a b)))))        (calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b)))))
1258    
1259  (defun math-inner-mats (a b)  (defun math-inner-mats (a b)
1260    (let ((mat nil)    (let ((mat nil)
# Line 1250  Line 1264 
1264        (setq col cols        (setq col cols
1265              row nil)              row nil)
1266        (while (> (setq col (1- col)) 0)        (while (> (setq col (1- col)) 0)
1267          (setq row (cons (calcFunc-reduce add-func          (setq row (cons (calcFunc-reduce math-inner-add-func
1268                                           (calcFunc-map mul-func                                           (calcFunc-map math-inner-mul-func
1269                                                         (car a)                                                         (car a)
1270                                                         (math-mat-col b col)))                                                         (math-mat-col b col)))
1271                          row)))                          row)))

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26