;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; calc-fast.lisp -- a simple stack-based calculator
;; intended for use in evolving calculator programs
;;
;; This is a faster version of calc.lisp, with the speed bought at the
;; price of not having push-button-style number entry or the option
;; of a calculator-like interface. 
;;
;; c) 1999, Lee Spector
;;
;; version 1.19990330 (n.yyyymmdd)

#|

Notes:

See comments in calc.lisp.

There are no number entry keys in this version, and no "." or ENTER keys.
You should use forms like "(push-stack 123.45)" to push numbers onto the
stack.

All of the number-entry and display stuff has been stripped out,
and with it a lot of expensive string manipulation. The result is a speedup
of approximately 500 times:

(defun calc-do-alot (num-times)
  (dotimes (i num-times)
    (progn (calc-clear)
           (calc-pi) (calc-pi) (calc-pi) (calc-pi) 
           (calc-pi) (calc-pi) (calc-pi)
           (calc-*) (calc-*) (calc-*) 
           (calc-*) (calc-*) (calc-*)))
  (calc-answer))

(defun calc-speed-test ()
  (time (calc-do-alot 1000)))

;; calc.lisp:

? (calc-speed-test)
(CALC-DO-ALOT 1000) took 9,330 milliseconds (9.330 seconds) to run.
Of that, 145 milliseconds (0.145 seconds) were spent in
The Cooperative Multitasking Experience.
486 milliseconds (0.486 seconds) was spent in GC.
 16,992,000 bytes of memory allocated.
3020.293227776791
? 

;; calc-fast.lisp:

? (calc-speed-test)
(CALC-DO-ALOT 1000) took 19 milliseconds (0.019 seconds) to run.
Of that, 1 milliseconds (0.001 seconds) were spent in
The Cooperative Multitasking Experience.
4 milliseconds (0.004 seconds) was spent in GC.
 208,000 bytes of memory allocated.
3020.293227776791
? 


|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; global variables


(defvar *calc-stack* nil 
  "The stack of the stack-based calculator")

(defvar *calc-result-just-displayed* nil
  "A flag to facilitate handling of a special case for the calculator state.")

(defvar *calc-enter-just-pressed* nil
  "A flag to facilitate handling of a special case for the calculator state.")

(defvar *a* 0
  "Holds the value of the A memory.")

(defvar *b* 0 
  "Holds the value of the B memory.")

(defparameter *basically-zero* 0.000000001
  "A small number, used to prevent over/underflow in certain numerical
operations. For example, if a number less than this appears as a denominator
then a special result (zero) is returned.")

(defun calc-clear ()
  "Clears the calculator's display, stack, and memory registers."
  (setq *calc-stack* (list 0)
        *a* 0
        *b* 0)
  (values))

(defun print-state ()
  "Prints the calculator's state to the standard output (usually
the terminal or a Listener window)."
  (format t "~%-- Calculator State --")
  (format t "~%A:~A, B:~A" *a* *b*)
  (format t "~%Stack:")
  (dolist (n *calc-stack*)
    (format t "~%~A~A" n (case n (0 " (x)") (1 " (y)") (t ""))))
  (format t "~%-- End --~%"))

(defun pop-stack ()
  "Removes and returns the number on top of the calculator stack,
or 0 if the stack is empty."
  (if (null *calc-stack*)
    0
    (let ((top (first *calc-stack*)))
      (setq *calc-stack* (rest *calc-stack*))
      top)))

(defun calc-answer ()
  "returns the number on top of the calculator stack,
or 0 if the stack is empty."
  (if (null *calc-stack*)
    0
    (first *calc-stack*)))

(defun push-stack (n)
  "Pushes n onto the calculator stack."
  (push n *calc-stack*)
  (values))

(defun calc-binary-op (op)
  "A utility for specifying binary calculator operators.
Op should be a function of two numbers that returns a number."
  (let* ((second-arg (pop-stack))
         (first-arg (pop-stack))
         (result (funcall op first-arg second-arg)))
    (push-stack result))
  (values))

(defun calc-unary-op (op)
  "A utility for specifying unary calculator operators.
Op should be a function of one number that returns a number."
  (let* ((arg (pop-stack))
         (result (funcall op arg)))
    (push-stack result))
  (values))

(defun calc-+ ()
  "Presses the plus (+) key on the calculator."
  (calc-binary-op #'+))

(defun calc-- ()
  "Presses the minus (-) key on the calculator."
  (calc-binary-op #'-))

(defun calc-* ()
  "Presses the times (* or x) key on the calculator."
  (calc-binary-op #'*))

(defun calc-/ ()
  "Presses the protected division (/) key on the calculator."
  (calc-binary-op
   #'(lambda (num denom)
       (if (<= (abs denom) *basically-zero*)
         0
         (float (/ num denom))))))

(defun calc-sqrt ()
  "Presses the square-root key on the calculator."
  (calc-unary-op #'(lambda (n) (sqrt (abs n)))))

(defun calc-chs ()
  "Presses the change-sign key on the calculator."
  (calc-unary-op #'(lambda (n) (- n))))

(defun calc-sq ()
  "Presses the 'square' key on the calculator."
  (calc-unary-op #'(lambda (n) (* n n))))

(defun calc-x^y ()
  "Presses the x^y (raise x to the y power) key on the calculator."
  (calc-binary-op
   #'(lambda (y x)
       (if (zerop x)
         0
         (expt (abs x) (if (zerop y) 0 y))))))

(defun calc-abs ()
  "Presses the absolute value key on the calculator."
  (calc-unary-op #'abs))

(defun calc-pi ()
  "Presses the pi (3.14...) key on the calculator."
  (push-stack pi))

(defun calc-e ()
  "Presses the e (2.71...) key on the calculator."
  (push-stack (exp 1)))

(defun calc-ln ()
  "Presses the natural log key on the calculator."
  (calc-unary-op 
   #'(lambda (arg)
       (if (<= (abs arg) *basically-zero*)
         0
         (log (abs arg))))))

(defun calc-sin ()
  "Presses the sine key on the calculator."
  (calc-unary-op #'sin))

(defun calc-cos ()
  "Presses the cosine key on the calculator."
  (calc-unary-op #'cos))

(defun calc-tan ()
  "Presses the tangent key on the calculator."
  (calc-unary-op #'tan))

(defun calc-1/x ()
  "Presses the 1/x (protected reciprocal) key on the calculator."
  (calc-unary-op
   #'(lambda (n) 
       (if (<= (abs n) *basically-zero*)
         0
         (float (/ 1 n))))))

(defun calc-a ()
  "Presses the memory A key on the calculator."
  (push-stack *a*))

(defun calc-b ()
  "Presses the memory B key on the calculator."
  (push-stack *b*))

(defun calc-set-a (n)
  "Sets the value of the calculator's A register to n"
  (setq *a* n)
  (values))

(defun calc-set-b (n)
  "Sets the value of the calculator's B register to n"
  (setq *b* n)
  (values))

(defun calc-x<->y ()
  "Exchanges the top two elements on the stack"
  (let ((arg1 (pop-stack))
        (arg2 (pop-stack)))
    (push-stack arg1)
    (push-stack arg2))
  (values))

;; initialize
(calc-clear)