Упрощение выражений на Lisp

Формулировка задачи:

Здравствуйте, уважаемые профессионалы и начинающие специалисты! Появилась необходимость в кратчайшие сроки реализовать небольшую программу на Lisp, суть которой состоит в упрощении арифметических выражений. К примеру, пользователь передаёт в функцию следующее выражение (+ (* 2 x) (* 2 x)) и должно вывести 4x. Раньше с подобными языками дела не имел, а сроки горят. Думаю, для спецов по данному языку подобное задание "как дважды два" . Кому не сложно и не жалко помочь, буду крайне благодарен! Для примера (возможно, его можно как-то модифицировать под это задание) сброшу мою программу по дифференцированию на Lisp (но не уверен, что она хороша). Заранее благодарен за ответы, с уважением.

Решение задачи: «Упрощение выражений на Lisp»

textual
                            Листинг программы 
                        
 
                            
                        
(setf (get '+ 'diff) 'diff_plus)
 
(setf (get '- 'diff) 'diff_minus)
 
(setf (get '* 'diff) 'diff_mult)
 
(setf (get '/ 'diff) 'diff_div)
 
(setf (get '+ 'reduce) 'reduce_plus)
 
(setf (get '- 'reduce) 'reduce_minus)
 
(setf (get '* 'reduce) 'reduce_mult)
 
(setf (get '/ 'reduce) 'reduce_div)
 
(defun diff_g(a x)
    (cond ((atom a) (if (eql a x) 1 0))
        (t (funcall  (get (car a) 'diff) (cdr a) 'x))
    )
)
 
(defun reduce_g(l)
    (cond ((atom l) l)
        (t (funcall (get (car l) 'reduce) (cdr l)))
    )
)
 
(defun diff_plus(l x)
    (list '+ (diff_g (car l) 'x) (diff_g (cadr l) 'x))
)
 
(defun diff_minus(l x)
    (list '- (diff_g (car l) 'x) (diff_g (cadr l) 'x))
)
 
(defun diff_mult(l x)
    (list '+ (list '* (diff_g (car l) 'x) (cadr l))
             (list '* (diff_g (cadr l) 'x) (car l))
    )
)
 
(defun reduce_plus(l)
    (cond
        ((and (numberp (car l)) (zerop (car l))) (cadr l))
        ((and (numberp (cadr l)) (zerop (cadr l))) (car l))
        ((and (numberp (car l)) (numberp (cadr l))) (+ (car l) (cadr l)))
        (t (list '+ (reduce_g (car l)) (reduce_g (cadr l))))
    )
)
 
(defun reduce_minus(l)
    (cond
        ((equal (car l) (cadr l)) 0)
        ((and (numberp (car l)) (zerop (car l))) (- 0 (cadr l)))
        ((and (numberp (cadr l)) (zerop (cadr l))) (car l))
        ((and (numberp (car l)) (numberp (cadr l))) (- (car l) (cadr l)))
        (t (list '- (reduce_g (car l)) (reduce_g (cadr l))))
    )
)
 
(defun reduce_mult(l)
    (cond
        ((and (numberp (car l)) (zerop (car l))) 0)
        ((and (numberp (cadr l)) (zerop (cadr l))) 0)
        ((and (numberp (car l)) (eql 1 (car l)) (cadr l)))
        ((and (numberp (car l)) (numberp (cadr l))) (* (car l) (cadr l)))
        (t (list '* (reduce_g (car l)) (reduce_g (cadr l))))
    )
)
 
(defun reduce_div(l)
    (cond
        ((and (numberp (car l)) (zerop (car l))) 0)
        ((and (numberp (cadr l)) (zerop (cadr l))) -111111111)
        ((and (numberp (cadr l)) (eql 1 (cadr l))) (car l))
        ((and (numberp (car l)) (numberp (cadr l))) (/ (car l) (cadr l)))
        (t (list '/ (reduce_g (car l)) (reduce_g (cadr l))))
    )
)
 
(defun diff_div(l x)
    (list '/ (list '- (list '* (diff_g (car l) x) (cadr l)) (list '* (diff_g (cadr l) x) (car l))) (list '* (car l) (car l)))
)
 
(defun reduce_f(next)
    (setq prev next)
    (setq next (reduce_g prev))
    (if (equal prev next) next (reduce_f next))
)