Function: math-rwapply-replace-regs

math-rwapply-replace-regs is a byte-compiled function defined in calc-rewr.el.gz.

Signature

(math-rwapply-replace-regs EXPR)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-rewr.el.gz
(defun math-rwapply-replace-regs (expr)
  (cond ((Math-primp expr)
	 expr)
	((eq (car expr) 'calcFunc-register)
	 (setq expr (aref math-apply-rw-regs (nth 1 expr)))
	 (if (eq (car-safe expr) '*)
	     (if (eq (nth 1 expr) -1)
		 (math-neg (nth 2 expr))
	       (if (eq (nth 1 expr) 1)
		   (nth 2 expr)
		 expr))
	   expr))
	((and (eq (car expr) 'calcFunc-eval)
	      (= (length expr) 2))
	 (calc-with-default-simplification
	  (math-normalize (math-rwapply-replace-regs (nth 1 expr)))))
	((and (eq (car expr) 'calcFunc-evalsimp)
	      (= (length expr) 2))
	 (math-simplify (math-rwapply-replace-regs (nth 1 expr))))
	((and (eq (car expr) 'calcFunc-evalextsimp)
	      (= (length expr) 2))
	 (math-simplify-extended (math-rwapply-replace-regs (nth 1 expr))))
	((and (eq (car expr) 'calcFunc-apply)
	      (= (length expr) 3))
	 (let ((func (math-rwapply-replace-regs (nth 1 expr)))
	       (args (math-rwapply-replace-regs (nth 2 expr)))
	       call)
	   (if (and (math-vectorp args)
		    (not (eq (car-safe (setq call (math-build-call
						   (math-var-to-calcFunc func)
						   (cdr args))))
			     'calcFunc-call)))
	       call
	     (list 'calcFunc-apply func args))))
	((and (eq (car expr) 'calcFunc-cons)
	      (= (length expr) 3))
	 (let ((head (math-rwapply-replace-regs (nth 1 expr)))
	       (tail (math-rwapply-replace-regs (nth 2 expr))))
	   (if (math-vectorp tail)
	       (cons 'vec (cons head (cdr tail)))
	     (list 'calcFunc-cons head tail))))
	((and (eq (car expr) 'calcFunc-rcons)
	      (= (length expr) 3))
	 (let ((head (math-rwapply-replace-regs (nth 1 expr)))
	       (tail (math-rwapply-replace-regs (nth 2 expr))))
	   (if (math-vectorp head)
	       (append head (list tail))
	     (list 'calcFunc-rcons head tail))))
	((and (eq (car expr) 'neg)
	      (math-rwapply-reg-looks-negp (nth 1 expr)))
	 (math-rwapply-reg-neg (nth 1 expr)))
	((and (eq (car expr) 'neg)
	      (eq (car-safe (nth 1 expr)) 'calcFunc-register)
	      (math-scalarp (aref math-apply-rw-regs (nth 1 (nth 1 expr)))))
	 (math-neg (math-rwapply-replace-regs (nth 1 expr))))
	((and (eq (car expr) '+)
	      (math-rwapply-reg-looks-negp (nth 1 expr)))
	 (list '- (math-rwapply-replace-regs (nth 2 expr))
	       (math-rwapply-reg-neg (nth 1 expr))))
	((and (eq (car expr) '+)
	      (math-rwapply-reg-looks-negp (nth 2 expr)))
	 (list '- (math-rwapply-replace-regs (nth 1 expr))
	       (math-rwapply-reg-neg (nth 2 expr))))
	((and (eq (car expr) '-)
	      (math-rwapply-reg-looks-negp (nth 2 expr)))
	 (list '+ (math-rwapply-replace-regs (nth 1 expr))
	       (math-rwapply-reg-neg (nth 2 expr))))
	((eq (car expr) '*)
	 (cond ((eq (nth 1 expr) -1)
		(if (math-rwapply-reg-looks-negp (nth 2 expr))
		    (math-rwapply-reg-neg (nth 2 expr))
		  (math-neg (math-rwapply-replace-regs (nth 2 expr)))))
	       ((eq (nth 1 expr) 1)
		(math-rwapply-replace-regs (nth 2 expr)))
	       ((eq (nth 2 expr) -1)
		(if (math-rwapply-reg-looks-negp (nth 1 expr))
		    (math-rwapply-reg-neg (nth 1 expr))
		  (math-neg (math-rwapply-replace-regs (nth 1 expr)))))
	       ((eq (nth 2 expr) 1)
		(math-rwapply-replace-regs (nth 1 expr)))
	       (t
		(let ((arg1 (math-rwapply-replace-regs (nth 1 expr)))
		      (arg2 (math-rwapply-replace-regs (nth 2 expr))))
		  (cond ((and (eq (car-safe arg1) '/)
			      (eq (nth 1 arg1) 1))
			 (list '/ arg2 (nth 2 arg1)))
			((and (eq (car-safe arg2) '/)
			      (eq (nth 1 arg2) 1))
			 (list '/ arg1 (nth 2 arg2)))
			(t (list '* arg1 arg2)))))))
	((eq (car expr) '/)
	 (let ((arg1 (math-rwapply-replace-regs (nth 1 expr)))
	       (arg2 (math-rwapply-replace-regs (nth 2 expr))))
	   (if (eq (car-safe arg2) '/)
	       (list '/ (list '* arg1 (nth 2 arg2)) (nth 1 arg2))
	     (list '/ arg1 arg2))))
	((and (eq (car expr) 'calcFunc-plain)
	      (= (length expr) 2))
	 (if (Math-primp (nth 1 expr))
	     (nth 1 expr)
	   (if (eq (car (nth 1 expr)) 'calcFunc-register)
	       (aref math-apply-rw-regs (nth 1 (nth 1 expr)))
	     (cons (car (nth 1 expr)) (mapcar 'math-rwapply-replace-regs
					      (cdr (nth 1 expr)))))))
	(t (cons (car expr) (mapcar 'math-rwapply-replace-regs (cdr expr))))))