When I write code from the bottom up, I tend to be surprised by how suddenly it all comes together at the end.  We now write a simple wrapper function, and have some basic calculator behaviour.  No real UI yet, but enough for basic testing.

We’ll write a function that takes the abbreviation string for a keypress, the stack and mode, and closures for unusual behaviour.  We will also allow it to take in numeric values as strings, and interpret those as requests to push those numbers onto the stack.  Note that we haven’t finished setting up the numeric key tokens yet, so we can’t actually handle single-digit numbers in this test code, they’ll get interpreted as keypresses, and won’t do what we want.  With that restriction, though, there is enough here for basic testing.

We parse the passed string for the abbreviation, and look up the key by its mode.  That lookup is a bit complicated because :RUN-MODE-NO-PROG is actually a logical sub-mode of :RUN-MODE, but with higher priority, but that’s not difficult to code.

We look for a numeric string and push it onto the stack if found.  We check to see if an argument is needed and not supplied, and if so we invoke the callback closure to obtain the argument.  Then, we call the function associated with the keypress, check for errors, and return to the caller.  Here is the code to do that, in a new file called engine.lisp:

(defun handle-one-keypress (key-string
                            fetch-argument-closure
                            check-for-interrupt-closure
                            stack mode)

  (declare (ignorable check-for-interrupt-closure))

  (labels
      ((matching-key-struct (abbrev mode ks)
         (and (string= abbrev (key-struct-abbrev ks))
              (member mode (key-struct-avail-modes ks))))

       (matching-key-fallback (abbrev mode ks)
         (when (eq mode :RUN-MODE-NO-PROG)
           (matching-key-struct abbrev :RUN-MODE ks))))

  (let* ((current-mode (modes-run/prog mode))
         (all-keys (get-keys))
         (tokenized (tokenize key-string))
         (abbrev (first tokenized))
         (arg (second tokenized))
         (key (car (or (member-if
                        #'(lambda (x)
                            (matching-key-struct abbrev
                                                 current-mode
                                                 x))
                        all-keys)
                       (member-if
                        #'(lambda (x)
                            (matching-key-fallback abbrev
                                                   current-mode
                                                   x))
                        all-keys)))))

    (unless key
      (let ((data (read-from-string key-string)))
        (typecase data
          (double-float
           (push-stack stack data :DOUBLE-FLOAT)
           (return-from handle-one-keypress :NORMAL-EXIT))
          (single-float
           (format t "Cannot handle single-precision floats")
           (return-from handle-one-keypress :ERROR))
          (rational
           (push-stack stack data :RATIONAL)
           (return-from handle-one-keypress :NORMAL-EXIT))
          (t
           (return-from handle-one-keypress :UNKNOWN-COMMAND)))))
           
    (when (and (key-struct-takes-arg key)
               (not arg))
      (setf arg (funcall fetch-argument-closure abbrev))
      (unless arg
        (return-from handle-one-keypress :MISSING-ARGUMENT)))

    (if (key-struct-takes-arg key)
        (funcall (key-struct-run-mode-fcn key)
                 stack mode arg)
        (funcall (key-struct-run-mode-fcn key)
                 stack mode))

    (if (stack-error-state stack)
        :ERROR
        :NORMAL-EXIT))))

Here are some examples of using this code to perform calculations.  In the first case, we add two numbers.  In the second, we multiple them, and in the third case we store the second number into a memory register.  The STO operation takes an argument, so it calls the closure to obtain its argument, and then continues:

CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "10" arg-fcn nil stack mode)
           (handle-one-keypress "20" arg-fcn nil stack mode)
           (handle-one-keypress "+" arg-fcn nil stack mode)
           stack)
#S(STACK
   :REGISTERS (30 0 0 0)
   :REGISTERS-COPY (20 10 0 0)
   :NUM-REGISTERS 4
   :LAST-X 20
   :MEMORY NIL
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)
CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "10" arg-fcn nil stack mode)
           (handle-one-keypress "20" arg-fcn nil stack mode)
           (handle-one-keypress "*" arg-fcn nil stack mode)
           stack)
#S(STACK
   :REGISTERS (200 0 0 0)
   :REGISTERS-COPY (20 10 0 0)
   :NUM-REGISTERS 4
   :LAST-X 20
   :MEMORY NIL
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)
CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "10" arg-fcn nil stack mode)
           (handle-one-keypress "20" arg-fcn nil stack mode)
           (handle-one-keypress "sto" arg-fcn nil stack mode)
           stack)
Argument for sto:  3

#S(STACK
   :REGISTERS (20 10 0 0)
   :REGISTERS-COPY (20 10 0 0)
   :NUM-REGISTERS 4
   :LAST-X 0
   :MEMORY (("3" . 20))
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)

This code is in the git repository under the tag v2014-11-14.