protohackers in CL (part 1 'call/cc')
See also ./protohackers-cl for more info.
So, after the simple thread-per-request version I put together last time, I wanted to see if I could handle multiple clients in an event-based way, on a single thread.
insights from reading code
usocket:wait-for-inputfunction is basically our
select(2); it takes a list of sockets and blocks until some subset are ready for reading.
I’ve played around some with
cl-coroutine(both on quicklisp);
cl-contprovides a bunch of sweet macros to transform some code into cps, and then manage running that code such that we can use
cl-coroutineis a really simple macro on top, which I’m not going to use, but which was instrumental in helping me get my head around how we can provide a DSL of sorts with
macroletgetting a body form in a macro.
With “select amongst ready sockets” and “coroutines” in my head from reading code this last couple of weeks, I’ve figured out a plan:
sketch of the plan
In pseudocode, we’re doing something like this:
socket-registry = make-hash-table server-socket = socket-listen *host* *port* loop: usocket:wait-for-input (hash-keys socket-registry) for each ready-socket: continuation = socket-registry[ready-socket] command, nextcont = funcall continuation ready-socket case command: wait: socket-registry[socket] = nextcont fork: socket-registry[socket] = client-handler socket socket-registry[server] = nextcont close: delete socket-registry[socket] close socket
socket-registrystores continuations from previous work against the socket
- assume the
server-socketgot into the hash table at some point, so
socket-acceptis part of the server’s coroutine loop
I like to write code where I just use the name of a function or macro that I haven’t written yet, to see what it feels like, so let’s start with this definition of the accept-loop coroutine. This is the one that’s performing the accept loop, accepting connections and forking them off into the registery for processing.
(cl-cont:defun/cc server-accept (socket handlerfn) ; 1. (loop do (wait-for-input socket) ; 2. (let ((client (usocket:socket-accept socket))) (fork-socket socket client handlerfn)))) ; 3.
Immediately confusing is
cl-cont:defun/cc; this is just a macro from the
cl-cont system which
builds a function definition in such a way that it’s usable with the cps transforms stuff that
macroexpand can be a very healthy excercise1.
Anyway, assuming we come back and implement
cl-cont based non-local returns,
this will do exactly what we want (sans error handling) — loop on the server socket, trying to accept connections.
fork-socket is a little different than
wait-for-input, in that it will actually run the other code
immediately (this function’s continuation and
handlerfn), collecting their results for updating the
Essentially it gives us a fork at the point of call — in one continuation, we’re the server, and continue
running after the fork, landing on
wait-for-input after finishing the
loop. In the other continuation,
we’re running whatever code was handed to us as
server-accept up the callstack,
Similarly, we’ll just define the client handler assuming the code that we’ll need;
(defun client-handler (socket) (loop do (wait-for-input socket) ; 1. (let* ((stream (usocket:socket-stream socket)) (input (read-line stream))) (if (equal input "quit") (close-and-finish socket) ; 2. (progn (format stream "echo: ~a~%" input) (finish-output stream))))))
Same thing here; assuming that
close-and-finish are non-local returns via whatever
continuation based runtime we’ve got, this shouldn’t ever block, and we should be able to handle mulitple
the actual runtime
Here it is, I’ll break it down after:
(defmacro wait-for-input (s) (alexandria:with-gensyms (cc) `(cl-cont:let/cc ,cc (list :wait ,s ,cc)))) (defmacro close-and-finish (s) `(cl-cont:let/cc _ (declare (ignorable _)) (list :close ,s))) (defmacro fork-socket (server client handler) (alexandria:with-gensyms (cc) `(cl-cont:let/cc ,cc (list :fork ,server ,cc ,client ,handler)))) (defun socket-handler-case (registry result) (alexandria:destructuring-case result ((:wait socket continue) (format t "waiting on ~A from ~A ~%" socket continue) (setf (gethash socket registry) continue)) ((:close socket) (format t "finished on ~A ~%" socket) (remhash socket registry) (usocket:socket-close socket)) ((:fork server-socket server-cont client-socket client-handler) (format t "forking from ~A to ~A ~A ~%" server-socket client-socket client-handler) (socket-handler-case registry (funcall server-cont server-socket)) (format t "...running client... ~%") (socket-handler-case registry (funcall client-handler client-socket))))) (defun make-server () (cl-cont:with-call/cc (let* ((registry (make-hash-table)) (server-socket (usocket:socket-listen "0.0.0.0" 6000 :reuseaddress t)) (server-result (server-listen server-socket #'client-handler))) ;; let the server get started, and register the server socket (socket-handler-case registry server-result) ;; now, we basically just loop over ready sockets, handling forks (loop do (format t "waiting for a ready socket ~%") (let* ((sockets (alexandria:hash-table-keys registry)) (ready (usocket:wait-for-input sockets :ready-only t))) (format t "ready sockets! ~%") (dolist (socket ready) (let* ((continue (gethash socket registry)) (command (funcall continue socket))) (format t "handled socket ~A ~%" socket) (socket-handler-case registry command))))))))
Despite being nearly impossible to actually read, thanks to copious
gensym, it’s obvious that the code has been transformed from something that runs linearly, to some stack of
(cl-cont:defun/cc example-defun (name) (format t "name ~a~%" name)) ;; macroexpands to: ;; (with a bunch of declare ignorable and storing to the symbol properties removed) (cl-cont::make-funcallable (lambda (#:g365 name) (funcall (lambda (&optional #:g366 &rest #:g367) (let ((#:g368 #:g365)) (funcall (lambda (&optional #:g369 &rest #:g370) (funcall (lambda (&optional #:g371 &rest #:g372) (funcall (lambda (&optional #:g373 &rest #:g374) (funcall (lambda (&optional #:g375 &rest #:g376) (funcall (cl-cont::fdesignator-to-function/cc #:g369) #:g368 #:g371 #:g373 #:g375)) name)) "name: ~a~%")) t)) #'format))) nil)))
Seeing this, I’m not sure if it’s a great idea memory wise, but it’s cool, so we’ll keep going for now. ↩