Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
RPN電卓
(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)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.