RPN電卓

rpn.lisp

(defparameter *stack* nil)

(defun push-stack (val)
  (push val *stack*))

(defun pop-stack ()
  (pop *stack*))

(defparameter *defined* nil)
(defun definedp (name)
  (assoc name *defined*))

(defun define-rpn-function (name function)
  (if (definedp name)
      (setf (cdr (assoc name *defined*)) function)
      (push (cons name function) *defined*)))

(defmacro defrpn (name &body body)
  `(define-rpn-function ',name
       (lambda () ,@body)))

(defun apply-rpn (val)
  (funcall (cdr (assoc val *defined*))))

(defrpn +
  (push-stack
   (+ (pop-stack) (pop-stack))))

(defrpn *
  (push-stack
   (* (pop-stack) (pop-stack))))

(defrpn -
  (push-stack
   (- (pop-stack) (pop-stack))))

(defrpn /
  (push-stack
   (/ (pop-stack) (pop-stack))))

(defrpn float (push-stack (float (pop-stack))))

(defrpn numerator (push-stack (numerator (pop-stack))))

(defrpn denominator (push-stack (denominator (pop-stack))))

(defrpn sqrt (push-stack (sqrt (pop-stack))))

(defun eval-rpn (expr &optional (resetp t))
  "Solve rpn expr. example, (1 2 + 3 4 * +) ==> (15)"
  (if resetp (setf *stack* nil)) 
  (if (null expr)
      nil
      (let ((val (car expr)))
        (cond ((definedp val) (apply-rpn val) (eval-rpn (cdr expr) nil))
              (t (push-stack val) (eval-rpn (cdr expr) nil)))))
  *stack*)

(defun repl-rpn ()
  (terpri)
  (princ "RPN> ")
  (let ((expr (read)))
    (cond ((eq expr 'quit) (princ "Bye."))
          ((eq expr 'reset) (setf *stack* nil) (princ "Reset") (repl-rpn))
          (t (princ (eval-rpn expr nil)) (repl-rpn)))))