X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/233ba4d924933cb56129bd7511e6137b7c0b8e3e..ba3189039adc8ec5eba5ed3e21d42019a4616b7c:/lisp/calc/calc-alg.el

diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 728acf5b0f..4bd37a4982 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -1,6 +1,6 @@
 ;;; calc-alg.el --- algebraic functions for Calc
 
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2014 Free Software Foundation, Inc.
 
 ;; Author: David Gillespie <daveg@synaptics.com>
 ;; Maintainer: Jay Belanger  <jay.p.belanger@gmail.com>
@@ -356,6 +356,8 @@
 ;; math-simplify-step, which is called by math-simplify.
 (defvar math-top-only)
 
+;; math-normalize-error is declared in calc.el.
+(defvar math-normalize-error)
 (defun math-simplify (top-expr)
   (let ((math-simplifying t)
 	(math-top-only (consp calc-simplify-mode))
@@ -383,10 +385,12 @@
       (calc-with-default-simplification
        (while (let ((r simp-rules))
 		(setq res (math-normalize top-expr))
-		(while r
-		  (setq res (math-rewrite res (car r))
-			r (cdr r)))
-		(not (equal top-expr (setq res (math-simplify-step res)))))
+                (if (not math-normalize-error)
+                    (progn
+                      (while r
+                        (setq res (math-rewrite res (car r))
+                              r (cdr r)))
+                      (not (equal top-expr (setq res (math-simplify-step res)))))))
 	 (setq top-expr res)))))
   top-expr)
 
@@ -415,17 +419,14 @@
 
 
 (defmacro math-defsimplify (funcs &rest code)
-  (append '(progn)
-          (mapcar (function
-                   (lambda (func)
-                     (list 'put (list 'quote func) ''math-simplify
-                           (list 'nconc
-                                 (list 'get (list 'quote func) ''math-simplify)
-                                 (list 'list
-                                       (list 'function
-                                             (append '(lambda (math-simplify-expr))
-                                                     code)))))))
-                  (if (symbolp funcs) (list funcs) funcs))))
+  (cons 'progn
+        (mapcar #'(lambda (func)
+                    `(put ',func 'math-simplify
+                          (nconc
+                           (get ',func 'math-simplify)
+                           (list
+                            #'(lambda (math-simplify-expr) ,@code)))))
+                (if (symbolp funcs) (list funcs) funcs))))
 (put 'math-defsimplify 'lisp-indent-hook 1)
 
 ;; The function created by math-defsimplify uses the variable
@@ -533,7 +534,10 @@
                            (not (Math-realp (nth 1 math-simplify-expr))))
 		       (math-common-constant-factor (nth 1 math-simplify-expr))))
 	  (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
-	      (progn
+	      (unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq)
+                           (eq (car-safe (nth 1 math-simplify-expr)) 'var)
+                           (not (math-expr-contains (nth 2 math-simplify-expr) 
+                                                    (nth 1 math-simplify-expr))))
 		(setcar (cdr math-simplify-expr)
                         (math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
 		(setcar (cdr (cdr math-simplify-expr))
@@ -1844,7 +1848,7 @@
 	     expr))))
 
 ;;; Simplify a polynomial in list form by stripping off high-end zeros.
-;;; This always leaves the constant part, i.e., nil->nil and nonnil->nonnil.
+;;; This always leaves the constant part, i.e., nil->nil and non-nil->non-nil.
 (defun math-poly-simplify (p)
   (and p
        (if (Math-zerop (nth (1- (length p)) p))