(define algebra-1
  (rule-simplifier
   (list

    ;; Associative law of addition
    (rule (+ (? a) (+ (? b) (? c)))
	  none
	  (+ (+ (? a) (? b)) (? c)))
    
    ;; Commutative law of multiplication
    (rule (* (? b) (? a))
	  (expr<? a b)
	  (* (? a) (? b)))

    ;; Distributive law of multiplication over addition
    (rule (* (? a) (+ (? b) (? c)))
	  none
	  (+ (* (? a) (? b)) (* (? a) (? c))))

    )))

(define (expr<? x y)
  (cond ((null? x)
	 (if (null? y) #f #t))
	((null? y) #f)
	((number? x)
	 (if (number? y) (< x y) #t))
	((number? y) #f)
	((symbol? x)
	 (if (symbol? y) (symbol<? x y) #t))
	((symbol? y) #f)
	((list? x)
	 (if (list? y)
	     (let ((nx (length x)) (ny (length y)))
	       (cond ((< nx ny) #t)
		     ((> nx ny) #f)
		     (else
		      (let lp ((x x) (y y))
			(cond ((null? x) #f) ; same
			      ((expr<? (car x) (car y)) #t)
			      ((expr<? (car y) (car x)) #f)
			      (else (lp (cdr x) (cdr y))))))))))
	((list? y) #f)
	(else
	 (error "Unknown expression type -- expr<?"
		x y))))

#|
(algebra-1 '(* (+ y (+ z w)) x))
;Value: (+ (+ (* x y) (* x z)) (* w x))
|#

(define algebra-2
  (rule-simplifier
   (list

    ;; Sums

    (rule (+ (? a)) none (? a))

    (rule (+ (?? a) (+ (?? b)))
	  none
	  (+ (?? a) (?? b)))

    (rule (+ (+ (?? a)) (?? b))
	  none
	  (+ (?? a) (?? b)))

    (rule (+ (?? a) (? y) (? x) (?? b))
	  (expr<? x y)
	  (+ (?? a) (? x) (? y) (?? b)))
    

    ;; Products

    (rule (* (? a)) none (? a))

    (rule (* (?? a) (* (?? b)))
	  none
	  (* (?? a) (?? b)))

    (rule (* (* (?? a)) (?? b))
	  none
	  (* (?? a) (?? b)))

    (rule (* (?? a) (? y) (? x) (?? b))
	  (expr<? x y)
	  (* (?? a) (? x) (? y) (?? b)))


    ;; Distributive law

    (rule (* (? a) (+ (?? b)))
	  none
	  (+ (?? (map (lambda (x) `(* ,a ,x)) b))))


    ;; Numerical simplifications below

    (rule (+ 0 (?? x)) none (+ (?? x)))

    (rule (+ (? x number?) (? y number?) (?? z))
	  none
	  (+ (? (+ x y)) (?? z)))


    (rule (* 0 (?? x)) none 0)
     
    (rule (* 1 (?? x)) none (* (?? x)))

    (rule (* (? x number?) (? y number?) (?? z))
	  none
	  (* (? (* x y)) (?? z)))

    )))

#|
(algebra-2 '(* (+ y (+ z w)) x))
;Value: (+ (* w x) (* x y) (* x z))

(algebra-2 '(+ (* 3 (+ x 1)) -3))
;Value: (* 3 x)
|#