Function: math-rwcomp-cond-instr

math-rwcomp-cond-instr is a byte-compiled function defined in calc-rewr.el.gz.

Signature

(math-rwcomp-cond-instr EXPR)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-rewr.el.gz
(defun math-rwcomp-cond-instr (expr)
  (let (op arg)
    (cond ((and (eq (car-safe expr) 'calcFunc-matches)
		(= (length expr) 3)
		(eq (car-safe (setq arg (math-rwcomp-match-vars (nth 1 expr))))
		    'calcFunc-register))
	   (math-rwcomp-pattern (nth 2 expr) (nth 1 arg)))
	  ((math-numberp (setq expr (math-rwcomp-match-vars expr)))
	   (if (Math-zerop expr)
	       (math-rwcomp-instr 'backtrack)))
	  ((and (eq (car expr) 'calcFunc-let)
		(= (length expr) 3))
	   (let ((reg (math-rwcomp-reg)))
	     (math-rwcomp-instr 'let reg (nth 2 expr))
	     (math-rwcomp-pattern (nth 1 expr) reg)))
	  ((and (eq (car expr) 'calcFunc-let)
		(= (length expr) 2)
		(eq (car-safe (nth 1 expr)) 'calcFunc-assign)
		(= (length (nth 1 expr)) 3))
	   (let ((reg (math-rwcomp-reg)))
	     (math-rwcomp-instr 'let reg (nth 2 (nth 1 expr)))
	     (math-rwcomp-pattern (nth 1 (nth 1 expr)) reg)))
	  ((and (setq op (cdr (assq (car-safe expr)
				    '( (calcFunc-integer  . integer)
				       (calcFunc-real     . real)
				       (calcFunc-constant . constant)
				       (calcFunc-negative . negative) ))))
		(= (length expr) 2)
		(or (and (eq (car-safe (nth 1 expr)) 'neg)
			 (memq op '(integer real constant))
			 (setq arg (nth 1 (nth 1 expr))))
		    (setq arg (nth 1 expr)))
		(eq (car-safe (setq arg (nth 1 expr))) 'calcFunc-register))
	   (math-rwcomp-instr op (nth 1 arg)))
	  ((and (assq (car-safe expr) calc-tweak-eqn-table)
		(= (length expr) 3)
		(eq (car-safe (nth 1 expr)) 'calcFunc-register))
	   (if (math-constp (nth 2 expr))
	       (let ((reg (math-rwcomp-reg)))
		 (setcar (nthcdr 3 (car math-regs)) (nth 2 expr))
		 (math-rwcomp-instr 'rel (nth 1 (nth 1 expr))
				    (car expr) reg))
	     (if (eq (car (nth 2 expr)) 'calcFunc-register)
		 (math-rwcomp-instr 'rel (nth 1 (nth 1 expr))
				    (car expr) (nth 1 (nth 2 expr)))
	       (math-rwcomp-instr 'cond expr))))
	  ((and (eq (car-safe expr) 'calcFunc-eq)
		(= (length expr) 3)
		(eq (car-safe (nth 1 expr)) '%)
		(eq (car-safe (nth 1 (nth 1 expr))) 'calcFunc-register)
		(math-constp (nth 2 (nth 1 expr)))
		(math-constp (nth 2 expr)))
	   (math-rwcomp-instr 'mod (nth 1 (nth 1 (nth 1 expr)))
			      (nth 2 (nth 1 expr)) (nth 2 expr)))
	  ((equal expr '(var remember var-remember))
	   (setq math-remembering 1))
	  ((and (eq (car-safe expr) 'calcFunc-remember)
		(= (length expr) 2))
	   (setq math-remembering (if math-remembering
				      (list 'calcFunc-lor
					    math-remembering (nth 1 expr))
				    (nth 1 expr))))
	  (t (math-rwcomp-instr 'cond expr)))))