;;;; Functions to put rational expressions in
;;;; normal form.
;;;;
;;;; File:         normal.lsp
;;;; Author:       CS 51 (Bob Walton)
;;;; Version:      1

;; expression ::= number | variable
;;	       | (+ expression expression)
;;	       | (- expression expression)
;;	       | (* expression expression)
;;	       | (/ expression expression)
;; variable ::= symbol except { + | - | * | / }
;;
;; factor ::= number | variable
;; monomial ::= factor | (* factor monomial)
;; polynomial ::= monomial | (+ monomial polynomial)
;;
;; Infix notation is often used in comments for
;; readability.
;;
;;
;; e, e1, e2, e3 are expressions
;; p, p1, p2, p3 are polynomials
;; m, m1, m2, m3 are monomials
;; f, f1, f2, f3 are factors
;; v, v1, v2, v3 are variables (symbols),
;; n, n1, n2, n3 are numbers,
;;
;;
;; f1 << f2 iff f1 is a number and f2 a symbol,
;;              or both f1 and f2 are symbols and
;;              f1 is alphabetically less than f2
;;
;; m1 << m2 iff the number of variable occurrences in m1
;;		is less than the number of variable
;;		occurrences in m1, or the list of
;;		variables in m1 is before the list of
;;		variables in m2 in dictionary order.

;; The following are the rules implemented by the
;; `normal' function.  These rules are terminating,
;; confluent, and sound, but they are not complete
;; because there is no rule to eliminate common factors.
;;
;; Rules for non-polynomials:
;;
;; ((p1 / p2) + e) ===> ((p1 + (p2 * e)) / p2)
;; (e + (p1 / p2)) ===> (((e * p2) + p1) / p2)
;; ((p1 / p2) * e) ===> ((p1 * e) / p2)
;; (e * (p1 / p2)) ===> ((e * p1) / p2)
;; ((p1 / p2) / e) ===> (p1 / (p2 * e))
;; (e / (p1 / p2)) ===> ((e * p2) / p1) if not p2 ===> 0
;; (e / (p1 / 0)) ===> (0 / 0)
;; (e1 - e2) ===> (e1 + (-1 * e2))
;; (e / 1) ===> e
;; (e / 0) ===> (0 / 0) if not e == 0

;; Rules for polynomials:
;;
;; ((e1 + e2) + e3) ===> (e1 + (e2 + e3))
;; ((e1 * e2) * e3) ===> (e1 * (e2 * e3))
;;
;; ((p1 + p2) * p3) ===> ((p1 * p3) + (p2 * p3))
;; (p1 * (p2 + p3)) ===> ((p1 * p2) + (p1 * p3))
;;
;; (f2 * f1) ===> (f1 * f2)		if f1 << f2
;; (f2 * (f1 * e)) ===> (f1 * (f2 * e)) if f1 << f2
;; (n2 * n1) ===> n3	if n3 = n1 * n2 mathematically
;; (n2 * (n1 * e)) ===> (n3 * e)
;;			if n3 = n1 * n2 mathematically
;; (1 * e) ===> e
;; (0 * e) ===> 0
;;
;; (m2 + m1) ===> (m1 + m2)		  if m1 << m2
;; (m2 + (m1 + e)) ===> (m1 + (m2 + e))   if m1 << m2
;; ((n1 * m) + (n2 * m)) ===> (n3 * m)
;;			if n3 = n1 * n2 mathematically
;; ((n1 * m) + ((n2 * m) + e)) ===> ((n3 * m) + e)
;;			if n3 = n1 * n2 mathematically
;; (n1 + n2) ===> n3	if n3 = n1 * n2 mathematically
;; (m + (n2 * m)) ===> (n3 * m)
;;			if n3 = 1 * n2 mathematically
;; ((n1 * m) + *) ===> (n3 * m)
;;			if n3 = n1 * 1 mathematically
;; (m + m) ===> (2 * m)
;; (n1 + (n2 + e)) ===> (n3 + e)
;;			if n3 = n1 * n2 mathematically
;; (m + ((n2 * m) + e)) ===> ((n3 * m) + e)
;;			if n3 = 1 * n2 mathematically
;; ((n1 * m) + (m + e)) ===> ((n3 * m) + e)
;;			if n3 = n1 * 1 mathematically
;; (m + (m + e)) ===> ((2 * m) + e)
;; (0 + e) ===> e

;; Variables to gather statistics on calls to normal.
;;
(defvar *did-rewrite* 0) ; Number of rewrites done.
(defvar *did-nothing* 0) ; Number of times no rewrite
			 ; was found.
(defvar *trace* nil)     ; True to print trace, false
			 ; not to.

;; Functions to gather statistics and output trace.

;; Call when rewriting an original expression to a new
;; rewritten expression.
;;
(defun rr (original-expression rewritten-expression)
  (setf *did-rewrite* (+ *did-rewrite* 1))
  (cond (*trace*
	 (fresh-line)
	 (princ `(,original-expression =>
	             ,rewritten-expression))
	 (fresh-line))))

;; Call when no applicable rewrite rule found.
;;
(defun no-rr ()
  (setf *did-nothing* (+ *did-nothing* 1)))

;; Call (RR-TIME (NORMAL-... ...)) to test a
;; version of the normal rewriter.
;;
(defmacro rr-time (expression)
  `(let ((result nil))
    (setf *did-nothing* 0)
    (setf *did-rewrite* 0)
    (setf result (time ,expression))
    (fresh-line)
    (terpri)
    (princ '|Number of Rewrites: |)
    (princ *did-rewrite*)
    (terpri)
    (princ
     '|Number of failures to find any rewrite: |)
    (princ *did-nothing*)
    (terpri)
    (terpri)
    result))


;; Functions to make code more readable
;;
;; x, y, z are s-expressions
;;
(defun op (e) (car e))	    ; (op '(x y z)) ===> 'x
(defun arg1 (e) (cadr e))   ; (arg1 '(x y z)) ===> 'y
(defun arg2 (e) (caddr e))  ; (arg2 '(x y z)) ===> 'z
;;
(defun isvar (e) (symbolp e))
(defun isfactor (e) (atom e))
(defun is+exp (e) (and (consp e) (eql '+ (op e))))
(defun is-exp (e) (and (consp e) (eql '- (op e))))
(defun is*exp (e) (and (consp e) (eql '* (op e))))
(defun is/exp (e) (and (consp e) (eql '/ (op e))))

;; Function to compare two monomials, and as factors
;; are also monomials, also two factors.
;;
;; x1, x2, y1, y2 are s-expressions; s1, s2 are symbols
;;
;; These rules must be applied in the given order.
;; (<< 'x1 'x2) is written as x1 << x2.
;;
;; (* n1 x1) << x2 ===> x1 << x2
;; x1 << (* n2 x2) ===> x1 << x2
;;
;; n1 << n2        ===> false
;; n1 << s2        ===> true
;; n1 << (x1 . y2) ===> true
;; s1 << n2        ===> false
;; s1 << s2        ===> s1 alphabetically < s2
;; s1 << (x1 . y2) ===> true
;;
;; (x1 . y1) << n1 ===> false
;; (x1 . y1) << s1 ===> false
;; x1 << x2	   ===> true
;;			if (length 'x1) < (length 'x2)
;; x1 << x2	   ===> false
;;			if (length 'x1) > (length 'x2)
;; (x1 . y1) << (x2 . y2)) ===> true if x1 << x2
;; (x1 . y1) << (x2 . y2)) ===> false if x2 << x1
;; (x1 . y1) << (x2 . y2)) ===> y1 << y2 otherwise 


(defun << (e1 e2)

  (cond
   ((and (is*exp e1)		; (* n1 x1) << x2 ===>
	 (numberp (arg1 e1)))	;   x1 << x2
    (<< (arg2 e1) e2))

   ((and (is*exp e2)		; x1 << (* n2 x2) ===>
	 (numberp (arg1 e2)))	;   x1 << x2
    (<< e1 (arg2 e2)))

   ((numberp e1)
    (cond
     ((numberp e2) nil)		; n1 << n2 ===> false
     ((symbolp e2) t)		; n1 << s2 ===> true
     ((consp e2) t)))		; n1 << (x1 . y2)
				;          ===> true
   ((symbolp e1)
    (cond
     ((numberp e2) nil)		; s1 << n2 ===> false
     ((symbolp e2)		; s1 << s2 ===>
      (string-lessp e1 e2))	;   s1 alphabetically
				;      < s2
     ((consp e2) t)))		; s1 << (x2 . y2)
				;          ===> true
   ((consp e1)
    (cond
     ((numberp e2) nil)		; (x1 . y1) << n2
				;          ===> false
     ((symbolp e2) nil)		; (x1 . y1) << s2
				;          ===> false
     ((consp e2)
      (let ((l1 (length e1))
            (l2 (length e2)))
       (cond
	((< l1 l2) t)	; (length 'e1) < (length 'e2)
			;	===> true
	((> l1 l2) nil)	; (length 'e1) > (length 'e2)
			;	===> false
	((<< (car e1) (car e2))	; (x1 . y1) << (x2 . y2)
	 t)			;   ===> true
				;        if x1 << x2
	((<< (car e2) (car e1))	; (x1 . y1) << (x2 . y2)
	 nil)			;   ===> false
				;	 if x2 << x1
	(t			; (x1 . y1) << (x2 . y2)
				;   ===> y1 << y2 
	 (<< (cdr e1) (cdr e2)))))))))) ;  otherwise 

;; Return the normal form of a rational expression.
;;
(defun normal (e)
  (cond
   ;; Base cases:
   ;;
   ((isvar e)		; v ===> v
    (no-rr)
    e)
   ((numberp e)		; n ===> n
    (no-rr)
    e)

   ;; Apply rules to operator with normal arguments.
   ;;
   (t
    (apply-rules `(,(op e)
		    ,(normal (arg1 e))
		    ,(normal (arg2 e)))))))


;; If possible apply rules to an expression that has
;; a binary operator whose operands are already in
;; normal form.
;;
(defun apply-rules (e)
  (cond

   ;; Apply rules for non-polynomials first.  After
   ;; these have been checked for, we will know that all
   ;; strict subexpressions are polynomials.

   ;; Move sums inside divisions:
   ;;
   ;;   (+ (/ p1 p2) e3) ===> (/ (+ p1 (* p2 e3)) p2)
   ;;
   ((and (is+exp e)
	 (is/exp (arg1 e)))
    (rr e `(/ (+ ,(arg1 (arg1 e))
		 (* ,(arg2 (arg1 e)) ,(arg2 e)))
	      ,(arg2 (arg1 e))))
    (apply-rules
     `(/ ,(apply-rules
	   `(+ ,(arg1 (arg1 e))
	       ,(apply-rules
		 `(* ,(arg2 (arg1 e)) ,(arg2 e)))))
	 ,(arg2 (arg1 e)))))

   ;;   (+ e3 (/ p1 p2)) ===> (/ (+ (* e3 p2) p1) p2)
   ;;
   ((and (is+exp e)
	 (is/exp (arg2 e)))
    (rr e `(/ (+ (* ,(arg1 e) ,(arg2 (arg2 e)))
		 ,(arg1 (arg2 e)))
	      ,(arg2 (arg2 e))))
    (apply-rules
     `(/ ,(apply-rules
	   `(+ ,(apply-rules
		 `(* ,(arg1 e) ,(arg2 (arg2 e))))
	       ,(arg1 (arg2 e))))
	 ,(arg2 (arg2 e)))))

   ;; Move products inside divisions:
   ;;
   ;;   (* (/ p1 p2) e3) ===> (/ (* p1 e3) p2)
   ;;
   ((and (is*exp e)
	 (is/exp (arg1 e)))
    (rr e `(/ (* ,(arg1 (arg1 e)) ,(arg2 e))
	      ,(arg2 (arg1 e))))
    (apply-rules
     `(/ ,(apply-rules `(* ,(arg1 (arg1 e)) ,(arg2 e)))
	 ,(arg2 (arg1 e)))))

   ;;   (* e1 (/ p2 p3)) ===> (/ (* e1 p2) p3)
   ;;
   ((and (is*exp e)
	 (is/exp (arg2 e)))
    (rr e `(/ (* ,(arg1 e) ,(arg1 (arg2 e)))
	      ,(arg2 (arg2 e))))
    (apply-rules
     `(/ ,(apply-rules `(* ,(arg1 e) ,(arg1 (arg2 e))))
	 ,(arg2 (arg2 e)))))

   ;; Eliminate consecutive divisions:
   ;;
   ;;   (/ (/ p1 p2) e3) ===> (/ p1 (* p2 e3))
   ;;
   ((and (is/exp e)
	 (is/exp (arg1 e)))
    (rr e `(/ ,(arg1 (arg1 e))
	      (* ,(arg2 (arg1 e)) ,(arg2 e))))
    (apply-rules
     `(/ ,(arg1 (arg1 e))
	 ,(apply-rules
	   `(* ,(arg2 (arg1 e)) ,(arg2 e))))))

   ;;   (/ e1 (/ p2 p3)) ===> (/ (* e1 p3) p2)
   ;;		if not p3 ===> 0
   ;;
   ((and (is/exp e)
	 (is/exp (arg2 e))
	 (or (not (numberp (arg2 (arg2 e))))
	     (not (= (arg2 (arg2 e) 0)))))
    (rr e `(/ (* ,(arg1 e) ,(arg2 (arg2 e)))
	      ,(arg1 (arg2 e))))
    (apply-rules
     `(/ ,(apply-rules `(* ,(arg1 e) ,(arg2 (arg2 e))))
	 ,(arg1 (arg2 e)))))

   ;;   (/ e1 (/ p2 0)) ===> (/ 0 0)
   ;;
   ((and (is/exp e)
	 (is/exp (arg2 e))
	 (numberp (arg2 (arg2 e)))
	 (/= (arg2 (arg2 e)) 0))
    (rr e '(/ 0 0))
    '(/ 0 0))

   ;; Rewrite -:
   ;;
   ;;   (- e1 e2) ===> (+ e1 (* -1 e2))
   ;;
   ((is-exp e)
    (rr e `(+ ,(arg1 e) (* -1 ,(arg2 e))))
    (apply-rules `(+ ,(arg1 e)
		     ,(apply-rules `(* -1 ,(arg2 e))))))

   ;; Rewrite division by 1 and 0.
   ;;
   ;;   (/ e1 1)) ===> e1
   ;;   (/ e1 0)) ===> (/ 0 0) if not e1 == 0
   ;;
   ((and (is/exp e)
	 (numberp (arg2 e))
	 (= (arg2 e) 1))
    (rr e (arg1 e))
    (arg1 e))
   ((and (is/exp e)
	 (numberp (arg2 e))
	 (= (arg2 e) 0)
	 (not (eql (arg1 e) 0)))
    '(/ 0 0))

   ;; From this point on, all strict subexpressions
   ;; of e are polynomials.

   ;; Apply rules for polynomials:

   ;; Associate terms of sums to the right:
   ;;
   ;;	(+ (+ e1 e2) e3) ===> (+ e1 (+ e2 e3))
   ;;
   ((and (is+exp e)
	 (is+exp (arg1 e)))
    (rr e `(+ ,(arg1 (arg1 e))
	      (+ ,(arg2 (arg1 e)) ,(arg2 e))))
    (apply-rules
     `(+ ,(arg1 (arg1 e))
	 ,(apply-rules
	   `(+ ,(arg2 (arg1 e)) ,(arg2 e))))))

   ;; Associate factors of products to the right:
   ;;
   ;;	(* (* e1 e2) e3) ===> (* e1 (* e2 e3))
   ;;
   ((and (is*exp e)
	 (is*exp (arg1 e)))
    (rr e `(* ,(arg1 (arg1 e))
	      (* ,(arg2 (arg1 e)) ,(arg2 e))))
    (apply-rules
     `(* ,(arg1 (arg1 e))
	 ,(apply-rules
	   `(* ,(arg2 (arg1 e)) ,(arg2 e))))))

   ;; Distribute * over +:
   ;;
   ;;	(* (+ p1 p2) p3) ===> (+ (* p1 p3) (* p2 p3))
   ;;
   ((and (is*exp e)
	 (is+exp (arg1 e)))
    (rr e `(+ (* ,(arg1 (arg1 e)) ,(arg2 e))
	      (* ,(arg2 (arg1 e)) ,(arg2 e))))
    (apply-rules
     `(+ ,(apply-rules
	   `(* ,(arg1 (arg1 e)) ,(arg2 e)))
	 ,(apply-rules 
	   `(* ,(arg2 (arg1 e)) ,(arg2 e))))))

   ;;	(* p1 (+ p2 p3)) ===> (+ (* p1 p2) (* p1 p3))
   ;;
   ((and (is*exp e)
	 (is+exp (arg2 e)))
    (rr e `(+ (* ,(arg1 e) ,(arg1 (arg2 e)))
	      (* ,(arg1 e) ,(arg2 (arg2 e)))))
    (apply-rules
     `(+ ,(apply-rules
	   `(* ,(arg1 e) ,(arg1 (arg2 e))))
	 ,(apply-rules
	   `(* ,(arg1 e) ,(arg2 (arg2 e)))))))

   ;; Sort factors of products:
   ;;
   ;;	(* f2 f1) ===> (* f1 f2) if f1 << f2
   ;;
   ((and (is*exp e)
	 (isfactor (arg1 e))
	 (isfactor (arg2 e))
	 (<< (arg2 e) (arg1 e)))
    (rr e `(* ,(arg2 e) ,(arg1 e)))
    (apply-rules `(* ,(arg2 e) ,(arg1 e))))

   ;;	(* f2 (* f1 e3)) ===> (* f1 (* f2 e3))
   ;;		if f1 << f2
   ;;
   ((and (is*exp e)
	 (is*exp (arg2 e))
	 (isfactor (arg1 e))
	 (isfactor (arg1 (arg2 e)))
	 (<< (arg1 (arg2 e)) (arg1 e)))
    (rr e  `(* ,(arg1 (arg2 e))
	       (* ,(arg1 e) ,(arg2 (arg2 e)))))
    (apply-rules
     `(* ,(arg1 (arg2 e))
	 ,(apply-rules
	   `(* ,(arg1 e) ,(arg2 (arg2 e)))))))

   ;; Combine numeric factors of products:
   ;;
   ;;	(* n1 n2) ===> n3 if n3 = n1 * n2 mathematically
   ;;
   ((and (is*exp e)
	 (numberp (arg1 e))
	 (numberp (arg2 e)))
    (rr e (* (arg1 e) (arg2 e)))
    (* (arg1 e) (arg2 e)))

   ;;	(* n1 (* n2 m)) ===> (* n3 m)
   ;;	                  if n3 = n1 * n2 mathematically
   ;;
   ((and (is*exp e)
	 (is*exp (arg2 e))
	 (numberp (arg1 e))
	 (numberp (arg1 (arg2 e))))
    (rr e `(* ,(* (arg1 e) (arg1 (arg2 e)))
	      ,(arg2 (arg2 e))))
    (apply-rules `(* ,(* (arg1 e) (arg1 (arg2 e)))
		     ,(arg2 (arg2 e)))))

   ;; Simplify multiplication by 1 or 0:
   ;;
   ;;	(* 1 e2) ===> e2
   ;;
   ((and (is*exp e)
	 (numberp (arg1 e))
	 (= (arg1 e) 1))
    (rr e (arg2 e))
    (arg2 e))

   ;;	(* 0 e2) ===> 0
   ;;
   ((and (is*exp e)
	 (numberp (arg1 e))
	 (= (arg1 e) 0))
    (rr e 0)
    0)

   ;; Sort terms of sums:
   ;;
   ;;	(+ m2 m1) ===> (+ m1 m2) if m1 << m2
   ;;	
   ((and (is+exp e)
	 (or (isfactor (arg1 e)) (is*exp (arg1 e)))
	 (or (isfactor (arg2 e)) (is*exp (arg2 e)))
	 (<< (arg2 e) (arg1 e)))
    (rr e `(+ ,(arg2 e) ,(arg1 e)))
    (apply-rules `(+ ,(arg2 e) ,(arg1 e))))

   ;;	(+ m2 (+ m1 e)) ===> (+ m1 (+ m2 e))
   ;;		if m1 << m2
   ;;
   ((and (is+exp e)
	 (is+exp (arg2 e))
	 (or (isfactor (arg1 e)) (is*exp (arg1 e)))
	 (or (isfactor (arg1 (arg2 e)))
	     (is*exp (arg1 (arg2 e))))
	 (<< (arg1 (arg2 e)) (arg1 e)))
    (rr e  `(+ ,(arg1 (arg2 e))
	       (+ ,(arg1 e) ,(arg2 (arg2 e)))))
    (apply-rules
     `(+ ,(arg1 (arg2 e))
	 ,(apply-rules
	   `(+ ,(arg1 e) ,(arg2 (arg2 e)))))))

   ;; Combine terms of sums:
   ;;
   ;;	(+ (* n1 m) (* n2 m) ) ===> (* n3 m)
   ;;	                  if n3 = n1 + n2 mathematically
   ;;
   ((and (is+exp e)
	 (is*exp (arg1 e))
	 (is*exp (arg2 e))
	 (numberp (arg1 (arg1 e)))
	 (numberp (arg1 (arg2 e)))
	 (equal (arg2 (arg1 e))
		(arg2 (arg2 e))))
    (rr e `(* ,(+ (arg1 (arg1 e)) (arg1 (arg2 e)))
		 ,(arg2 (arg1 e))))
    (apply-rules
     `(* ,(+ (arg1 (arg1 e)) (arg1 (arg2 e)))
	 ,(arg2 (arg1 e)))))

   ;;	(+ (* n1 m) (+ (* n2 m) e3)) ===> (+ (* n3 m) e3)
   ;;	                  if n3 = n1 + n2 mathematically
   ;;
   ((and (is+exp e)
	 (is*exp (arg1 e))
	 (is+exp (arg2 e))
	 (is*exp (arg1 (arg2 e)))
	 (numberp (arg1 (arg1 e)))
	 (numberp (arg1 (arg1 (arg2 e))))
	 (equal (arg2 (arg1 e))
		(arg2 (arg1 (arg2 e)))))
    (rr e `(+ (* ,(+ (arg1 (arg1 e))
		     (arg1 (arg1 (arg2 e))))
		 ,(arg2 (arg1 e)))
	      ,(arg2 (arg2 e))))
    (apply-rules
     `(+ ,(apply-rules
	   `(* ,(+ (arg1 (arg1 e))
		   (arg1 (arg1 (arg2 e))))
	       ,(arg2 (arg1 e))))
	 ,(arg2 (arg2 e)))))

   ;;	(+ n1 n2) ===> n3 if n3 = n1 + n2 mathematically
   ;;
   ((and (is+exp e)
	 (numberp (arg1 e))
	 (numberp (arg2 e)))
    (rr e (+ (arg1 e) (arg2 e)))
    (+ (arg1 e) (arg2 e)))

   ;;	(+ m (* n2 m) ) ===> (* n3 m)
   ;;	                  if n3 = 1 + n2 mathematically
   ;;
   ((and (is+exp e)
	 (is*exp (arg2 e))
	 (numberp (arg1 (arg2 e)))
	 (equal (arg1 e)
		(arg2 (arg2 e))))
    (rr e `(* ,(+ 1 (arg1 (arg2 e))) ,(arg1 e)))
    (apply-rules `(* ,(+ 1 (arg1 (arg2 e))) ,(arg1 e))))

   ;;	(+ (* n1 m) m) ===> (* n3 m)
   ;;	                  if n3 = n1 + 1 mathematically
   ;;
   ((and (is+exp e)
	 (is*exp (arg1 e))
	 (numberp (arg1 (arg1 e)))
	 (equal (arg2 (arg1 e))
		(arg2 e)))
    (rr e `(* ,(+ (arg1 (arg1 e)) 1) ,(arg2 e)))
    (apply-rules `(* ,(+ (arg1 (arg1 e)) 1) ,(arg2 e))))

   ;;	(+ m m) ===> (* 2 m)
   ;;
   ((and (is+exp e)
	 (or (isfactor (arg1 e)) (is*exp (arg1 e)))
	 (or (isfactor (arg2 e)) (is*exp (arg2 e)))
	 (equal (arg1 e) (arg2 e)))
    (rr e `(* 2 ,(arg1 e)))
    (apply-rules `(* 2 ,(arg1 e))))

   ;;	(+ n1 (+ n2 e3)) ===> (+ n3 e3)
   ;;	                  if n3 = n1 + n2 mathematically
   ;;
   ((and (is+exp e)
	 (is+exp (arg2 e))
	 (numberp (arg1 e))
	 (numberp (arg1 (arg2 e))))
    (rr e `(+ ,(+ (arg1 e) (arg1 (arg2 e)))
	      ,(arg2 (arg2 e))))
    (apply-rules `(+ ,(+ (arg1 e) (arg1 (arg2 e)))
		     ,(arg2 (arg2 e)))))

   ;;	(+ m (+ (* n2 m) e3)) ===> (+ (* n3 m) e3)
   ;;	                  if n3 = 1 + n2 mathematically
   ;;
   ((and (is+exp e)
	 (is+exp (arg2 e))
	 (is*exp (arg1 (arg2 e)))
	 (numberp (arg1 (arg1 (arg2 e))))
	 (equal (arg1 e)
		(arg2 (arg1 (arg2 e)))))
    (rr e `(+ (* ,(+ 1 (arg1 (arg1 (arg2 e))))
		 ,(arg1 e))
	      ,(arg2 (arg2 e))))
    (apply-rules
     `(+ ,(apply-rules `(* ,(+ 1 (arg1 (arg1 (arg2 e))))
			   ,(arg1 e)))
	 ,(arg2 (arg2 e)))))

   ;;	(+ (* n1 m) (+ m e3)) ===> (+ (* n3 m) e3)
   ;;	                  if n3 = n1 + 1 mathematically
   ;;
   ((and (is+exp e)
	 (is*exp (arg1 e))
	 (is+exp (arg2 e))
	 (numberp (arg1 (arg1 e)))
	 (equal (arg2 (arg1 e))
		(arg1 (arg2 e))))
    (rr e `(+ (* ,(+ (arg1 (arg1 e)) 1)
		 ,(arg2 (arg1 e)))
	      ,(arg2 (arg2 e))))
    (apply-rules
     `(+ ,(apply-rules `(* ,(+ (arg1 (arg1 e)) 1)
			   ,(arg2 (arg1 e))))
	 ,(arg2 (arg2 e)))))

   ;;	(+ m (+ m e3)) ===> (+ (* 2 m) e3)
   ;;
   ((and (is+exp e)
	 (is+exp (arg2 e))
	 (equal (arg1 e)
		(arg1 (arg2 e))))
    (rr e `(+ (* 2 ,(arg1 e)) ,(arg2 (arg2 e))))
    (apply-rules
     `(+ ,(apply-rules `(* 2 ,(arg1 e)))
	 ,(arg2 (arg2 e)))))

   ;; Simplify addition of 0:
   ;;
   ;;	(+ 0 e2) ===> e2
   ;;
   ((and (is+exp e)
	 (numberp (arg1 e))
	 (= (arg1 e) 0))
    (rr e (arg2 e))
    (arg2 e))

   ;; Done!
   ;;
   (t
    (no-rr)
    e)))