- "Reduce the stack using top operator.
-PREC is a precedence - reduce everything with higher precedence."
- (while
- (cond
- ((and (cdr (cdr calculator-stack)) ; have three values
- (consp (nth 0 calculator-stack)) ; two operators & num
- (numberp (nth 1 calculator-stack))
- (consp (nth 2 calculator-stack))
- (eq '\) (nth 1 (nth 0 calculator-stack)))
- (eq '\( (nth 1 (nth 2 calculator-stack))))
- ;; reduce "... ( x )" --> "... x"
- (setq calculator-stack
- (cons (nth 1 calculator-stack)
- (nthcdr 3 calculator-stack)))
- ;; another iteration
- t)
- ((and (cdr (cdr calculator-stack)) ; have three values
- (numberp (nth 0 calculator-stack)) ; two nums & operator
- (consp (nth 1 calculator-stack))
- (numberp (nth 2 calculator-stack))
- (= 2 (calculator-op-arity ; binary operator
- (nth 1 calculator-stack)))
- (<= prec ; with higher prec.
- (calculator-op-prec (nth 1 calculator-stack))))
- ;; reduce "... x op y" --> "... r", r is the result
- (setq calculator-stack
- (cons (calculator-funcall
- (nth 2 (nth 1 calculator-stack))
- (nth 2 calculator-stack)
- (nth 0 calculator-stack))
- (nthcdr 3 calculator-stack)))
- ;; another iteration
- t)
- ((and (>= (length calculator-stack) 2) ; have two values
- (numberp (nth 0 calculator-stack)) ; number & operator
- (consp (nth 1 calculator-stack))
- (= -1 (calculator-op-arity ; prefix-unary op
- (nth 1 calculator-stack)))
- (<= prec ; with higher prec.
- (calculator-op-prec (nth 1 calculator-stack))))
- ;; reduce "... op x" --> "... r" for prefix op
- (setq calculator-stack
- (cons (calculator-funcall
- (nth 2 (nth 1 calculator-stack))
- (nth 0 calculator-stack))
- (nthcdr 2 calculator-stack)))
- ;; another iteration
- t)
- ((and (cdr calculator-stack) ; have two values
- (consp (nth 0 calculator-stack)) ; operator & number
- (numberp (nth 1 calculator-stack))
- (= +1 (calculator-op-arity ; postfix-unary op
- (nth 0 calculator-stack)))
- (<= prec ; with higher prec.
- (calculator-op-prec (nth 0 calculator-stack))))
- ;; reduce "... x op" --> "... r" for postfix op
- (setq calculator-stack
- (cons (calculator-funcall
- (nth 2 (nth 0 calculator-stack))
- (nth 1 calculator-stack))
- (nthcdr 2 calculator-stack)))
- ;; another iteration
- t)
- ((and calculator-stack ; have one value
- (consp (nth 0 calculator-stack)) ; an operator
- (= 0 (calculator-op-arity ; 0-ary op
- (nth 0 calculator-stack))))
- ;; reduce "... op" --> "... r" for 0-ary op
- (setq calculator-stack
- (cons (calculator-funcall
- (nth 2 (nth 0 calculator-stack)))
- (nthcdr 1 calculator-stack)))
- ;; another iteration
- t)
- ((and (cdr calculator-stack) ; have two values
- (numberp (nth 0 calculator-stack)) ; both numbers
- (numberp (nth 1 calculator-stack)))
- ;; get rid of redundant numbers:
- ;; reduce "... y x" --> "... x"
- ;; needed for 0-ary ops that puts more values
- (setcdr calculator-stack (cdr (cdr calculator-stack))))
- (t ;; no more iterations
- nil))))