Форум программистов [Powered by Invision Power Board]

Код

(defparameter *operators* (make-hash-table :test #'eq))

(defun set-operator (symbol priority function)
  (setf (gethash symbol *operators*)
        (cons priority function)))

(defun get-operator-priority (symbol)
  (multiple-value-bind (op foundp) (gethash symbol *operators*)
    (when foundp (car op))))

(defun get-operator-function (symbol)
  (multiple-value-bind (op foundp) (gethash symbol *operators*)
    (when foundp (cdr op))))

(defun operator-p (symbol &optional (errorp nil))
  (multiple-value-bind (op foundp) (gethash symbol *operators*)
    (declare (ignore op))
    (if (eq errorp t)
        (or foundp (error "Unknown operator ~a" symbol))
      foundp)))



(defun eval-infix (expr)
  (do ((expr expr))
      ((atom expr) expr)
    (destructuring-bind (left &rest rest) expr
      (if (null rest)
          (setf expr left)
        (destructuring-bind (op &rest rest) rest
          (operator-p op t)
          (if (null rest)
              (error "No right operand in (~s ~s)" left op)
            (destructuring-bind (right &rest rest) rest
              (if (null rest)
                  (setf expr
                        (funcall (get-operator-function op)
                                 (eval-infix left)
                                 (eval-infix right)))
                (destructuring-bind (rest-op &rest rest) rest
                  (operator-p rest-op t)
                  (let ((p1 (get-operator-priority op))
                        (p2 (get-operator-priority rest-op)))
                    (setf expr
                          (if (> p2 p1)
                              (list left op (eval-infix (list* right rest-op rest)))
                              (list* (funcall (get-operator-function op)
                                              (eval-infix left)
                                              (eval-infix right))
                                     rest-op
                                     rest)))))))))))))

(set-operator '+ 0 #'+)
(set-operator '- 0 #'-)
(set-operator '* 2 #'*)
(set-operator '/ 2 #'/)
(set-operator '^ 4 #'expt)

(defun calculate (expr)
  (eval-infix expr))