四則演算

四則演算をCLで。

(defun parse-calc (string)
  "Parse calc string.
operator: +,-,*,/ 
number is only 0-9."
  (parse-calc-iter (make-string-input-stream string)))

(defun parse-calc-iter (stream)
  (let ((table (make-hash-table))) ;; operator => priority. max priority is 9.
    (flet ((prio (c) (gethash c table))
           ((setf prio) (new-prio c) (setf (gethash c table) new-prio)))
      (loop for c = (read-char stream nil :eof nil)
         with result ;; parsed result
         with stack ;; stack
         initially ;; init operator priority
           (setf (prio #\*) 7)
           (setf (prio #\/) 7)
           (setf (prio #\+) 6)
           (setf (prio #\-) 6)
         while (not (eql c :eof)) do
           (cond
             ((eql c #\()
              (loop for s in (parse-calc-iter stream) do (push s result)))
             ((eql c #\))
              (loop-finish))
             ((member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) :test #'eql)
              (push (parse-integer (string c)) result))
             (t ;; operator
              (when (and stack (<= (prio c) (prio (car stack))))
                (loop while stack do (push (pop stack) result)))
              (push c stack)))
         finally
           (loop while stack do (push (pop stack) result))
           (return (reverse result))))))

(defun interp-calc (exp)
  (loop with stack = nil
     for s in exp do
       (cond
         ((numberp s)
          (push s stack))
         ((member s '(#\+ #\- #\* #\/))
          (let* ((b (pop stack))
                 (a (pop stack)))
            (push (funcall (case s
                             (#\+ #'+)
                             (#\- #'-)
                             (#\* #'*)
                             (#\/ #'/)) a b) stack))))
     finally
       (return stack)))

(defun calc (string)
  "calculate expression.
ex. (calc \"1+2+3\") => (6)
ex. (calc \"5-3*2\") => (-1)
ex. (calc \"(5-3)*2\") => (4)"
  (interp-calc (parse-calc string)))