(defun reduce-expression (thing)
  (etypecase thing
    (real
     (list (float thing 0f0)))
    (symbol
     (list 0f0 (list thing 1f0)))
    (cons
     (destructuring-bind (op . args) thing
       (ecase op
         (quote (list 0f0 (list thing 1f0)))
         (* (let ((vars NIL) (const 1f0))
              (dolist (arg args)
                (destructuring-bind (inner . terms) (reduce-expression arg)
                  (if terms
                      (if vars
                          (error "This is not a linear expression.~%  ~a" thing)
                          (setf vars (cons inner terms)))
                      (setf const (* const inner)))))
              (list* (* const (or (car vars) 1f0))
                     (loop for (var mult) in (rest vars)
                           collect (list var (* mult const))))))
         (/ (destructuring-bind (a &rest rest) args
              (destructuring-bind (aconst . avars) (reduce-expression a)
                (destructuring-bind (const . vars) (reduce-expression (list* '+ rest))
                  (when vars
                    (error "This is not a linear expression.~%  ~a" thing))
                  (append (list (/ aconst const))
                          (loop for (var mult) in avars
                                collect (list var (/ mult const))))))))
         (+ (let ((vars ()) (const 0f0))
              (dolist (arg args)
                (destructuring-bind (inner . terms) (reduce-expression arg)
                  (incf const inner)
                  (setf vars (append vars terms))))
              (list* const vars)))
         (- (destructuring-bind (a &rest rest) args
              (destructuring-bind (aconst . avars) (reduce-expression a)
                (destructuring-bind (const . vars) (reduce-expression (list* '+ rest))
                  (append (list (- aconst const))
                          avars
                          (loop for (var mult) in vars
                                collect (list var (- mult)))))))))))))