lispcommon-lispsbclansi-common-lisp

How do I ask a CommonLisp system to lookup symbols dynamically at runtime in compiled functions?


As a preamble, I am implementing two simple commands I can use via a little package in SBCL, which emulates Allegro repl. The package is sb-aclrepl, found in the contrib folder in SBCL sources. The commands should start and stop Slynk or Swank (was Astrid Lindgren a secret lisper?), depending on which I want to use. I am using both but on different machines, until I make my mind which I prefer.

Here is some intro code:

(in-package :sb-aclrepl)

(defstruct app-server
  (name "SLYNK" :type string)
  (port 4004 :type integer))

(defvar *server* (make-instance 'app-server))

That just stores a string and a number for ports. We need those to lookup symbols later, and to control on which port server starts (I found that Swank sometimes starts on some random port).

I would like to be able to write a simple code like this:

(defun server-run (&optional impl)
  (when impl
    (setf (app-server-name *server*) (string-upcase impl)))
  (ql:quickload (app-server-name *server*))
  (let ((cl:*package* (find-package (app-server-name *server*))))
    (create-server :port (incf (app-server-port *server*)) :dont-close t)))

(defun server-stop ()
  (let ((cl:*package* (find-package (app-server-name *server*))))
    (dolist (connection *connections*)
      (close-connection connection nil nil))))

This obviously does not work since the symbol lookup is done at read time. When the compiler compiles the code, it resolves Slynk or Swank related symbols to the current package. We get sb-aclrepl::*connections* instead of say, swank::*connections*.

We could do something like this:

(defun server-run (&optional impl)
  (when impl
    (setf (app-server-name *server*) (string-upcase impl)))
  #-(or :slynk :swank)
  (if (or (equal (app-server-name *server*) "SLYNK")
          (equal (app-server-name *server*) "SWANK"))
      (ql:quickload (app-server-name *server*))
      (error "I don't know how to load ~a~%" (app-server-name *server*)))
  #+:slynk
  (slynk:create-server :port (incf (app-server-port *server*)) :dont-close t)
  #+:swank
  (swank:create-server :port (incf (app-server-port *server*)) :dont-close t)
  #-(or :slynk :swank) ;; we shouldn't be here
  (error "I don't know how to start ~a~%" (app-server-name *server*)))

(defun server-stop ()
  #+slynk
  (dolist (connection slynk::*connections*)
    (slynk::close-connection connection nil nil))
  #+swank
  (dolist (connection swank::*connections*)
    (swank::close-connection connection nil nil))
  #-(or :slynk :swank) ;; we shouldn't be here
  (error "I don't know how to stop ~a~%" (app-server-name *server*)))

The problem with this is that either one has to be loaded at compile time. In practical terms, when we load ASDF system, either Slynk or Swank should be loaded as a dependency, or we have to tell ASDF somehow to load one of those. A simple solution is to control this via an environment variable, but we are in the land of C and C++ now. We have written two different applications, one per each application server, and if-defing which one is used at compile time as in a C program. Lisp is supposed to be a language for symbolic computations, isn't it? Can we do better? Can we not just say (server-start 'swank) and everything should just work?

To make that happen, we need to dynamically load required server, and to dynamically resolve symbols when an action is requested.

I was able to find two solutions, of which one is completely unacceptable, and the other one is inefficient. The first one was to force evaluation at execution time via (eval-when (:execute) ...).

That one is not acceptable in this particular case, because it seems to ask for every caller of the function to also be evaluated at the runtime. That is orthogonal to setting up a dispatch table with available commands so I can call this function via an interactive command. If I add :compile-toplevel that forces evaluation at compile time which is what we started with. As an alternative, I could perhaps rewrite sb-aclrepl to work differently, but that is out of scope for this question and out of my interest too.

The second one, the one I present here, is to generate the code via macro, and than arrange for the macro to be somehow evaluated at runtime. It is acceptable to evaluate this at the top level scope, so I just use eval here:

(defun server-run (&optional impl)
  (when impl
    (setf (app-server-name *server*) (string-upcase impl)))
  (unless (find-package (app-server-name *server*))
    (ql:quickload (app-server-name *server*)))
  (eval
   `(let ((run (find-symbol "CREATE-SERVER" (app-server-name *server*))))
      (funcall run :port (incf (app-server-port *server*)) :dont-close t))))

(defun server-stop ()
  (eval
   `(let* ((server (app-server-name *server*))
           (close (find-symbol "CLOSE-CONNECTION" server))
           (connections (symbol-value (find-symbol "*CONNECTIONS*" server))))
      (dolist (connection connections)
        (funcall close connection nil nil)))))

As a note, the actual interface is (server-run STRING), not (server-run SYMBOL). This is due to how sb-aclrepl works. I can type: :sr swank at the repl, and it will translate symbol to a string for me, so we don't call symbol-name in server-run.

However, that is obviously computationally less efficient, since eval forces the code compilation at the runtime. This is obviously not a performance intensive code. It is used interactively and once at the start and at the end of a session, so I can live with eval.

However, for my own curiosity and learning purpose, I have a question: how can I ask a CommonLisp system to lookup symbols at runtime without using eval and a macro, or without forcing the entire call-chain to be evaled at runtime. Is it possible, and if it is, how do I do it, preferably in a portable way?

Edit: I think progv special form could also be used instead of eval, but I just came up on the thought, will try a bit later in the evening.


Solution

  • Improve the code

    Why this

    (eval
     `(let ((run (find-symbol "CREATE-SERVER" (app-server-name *server*))))
        (funcall run :port (incf (app-server-port *server*)) :dont-close t)))
    

    and not just this

    (let ((run (find-symbol "CREATE-SERVER" (app-server-name *server*))))
      (funcall run :port (incf (app-server-port *server*)) :dont-close t))
    

    ?

    Similar, why not just this:

    (defun server-stop ()
      (let* ((server (app-server-name *server*))
             (close (find-symbol "CLOSE-CONNECTION" server))
             (connections (symbol-value (find-symbol "*CONNECTIONS*" server))))
        (dolist (connection connections)
          (funcall close connection nil nil))))
    

    Runtime Lookup

    Common Lisp is designed so that there is no symbol lookup at runtime for function calls. It also allows the compiler to check function calls against a defined function specification: correct number of args, correct keyword arguments, and more.

    Finding a symbol from a package is done with FIND-SYMBOL. FIND-SYMBOL does not create new symbols. It has two arguments: the name of the symbol and the package of the symbol.

    CL-USER 58 > (defpackage "FOO" (:use))
    #<The FOO package, 0/16 internal, 0/16 external>
    
    CL-USER 59 > (intern "HELLO" "FOO")
    FOO::HELLO
    NIL
    
    CL-USER 60 > (find-symbol "HELLO")  ; -> wrong package
    NIL
    NIL
    
    CL-USER 61 > (find-symbol "HELLO" "FOO")
    FOO::HELLO
    :INTERNAL
    

    Above is all sequentially executed.

    READ and READ-FROM-STRING also do symbol lookup (remember to set *read-eval* to nil to prevent read time evaluation:

    CL-USER 62 > (let ((*read-eval* nil))
                   (read-from-string "(FOO::HELLO 1 2 3)"))
    (FOO::HELLO 1 2 3)
    18
    
    CL-USER 63 > (describe (first *))
    
    FOO::HELLO is a SYMBOL
    NAME          "HELLO"
    VALUE         #<unbound value>
    FUNCTION      #<unbound function>
    PLIST         NIL
    PACKAGE       #<The FOO package, 1/16 internal, 0/16 external>
    

    Now we want to call some function if we, at runtime, know its name and package:

    CL-USER 64 > (defun callnew (package name &rest args)
                   (apply (find-symbol name package)
                          args))
    CALLNEW
    
    CL-USER 65 > (defun foo::hello (a b c) (* a b c))
    FOO::HELLO
    
    CL-USER 66 > (callnew "FOO" "HELLO" 1 2 3)
    6
    

    The obvious drawbacks:

    Security

    Think about the consequences of loading and executing code or data at runtime. One could also add checks to callnew, such that only certain symbols can be called.