RSS Feed

Lisp Project of the Day

cl-cont

You can support this project by donating at:

Donate using PatreonDonate using Liberapay

Or see the list of project sponsors.

cl-contlanguage

Documentation🥺
Docstrings😀
Tests 😀
Examples🥺
RepositoryActivity🥺
CI 🥺

This is a pretty old system which implements Delimited Continuations for Common Lisp. Initially, it was part of the Weblocks web-framework.

Sadly, but cl-cont has no documentation. I found only one example on this page.

It always was hard to wrap my mind around continuations. Probably that is why I decided to remove their support from the core of the Weblocks when I did the refactoring.

Now it is time to dive into continuations and probably to return them to Weblocks as an additional library.

Let's see what continuation is and how they can be used in practice!

The first thing to note is that each piece of code which uses this magic should be wrapped into with-call/cc. The second thing to remember is that let/cc form allows you to capture the moment and to save the execution point somewhere.

The code below prints three lines. It prints "Begin", then captures the execution point, prints "Before returning" and returns the captured point:

POFTHEDAY> (cont:with-call/cc
             (format t "Begin~%")
             (cont:let/cc k
               (format t "Before returning k~%")
               k)
             (format t "End~%")
             :final-result)
Begin
Before returning k
#<FUNCTION (LAMBDA (&OPTIONAL #:G1455 &REST #:G1456)) {22A10A0B}>

What has happened to our third print "End"? It didn't have a chance to be executed yet. But we can continue execution, by calling the function we've received as the result on the previous code snippet:

POFTHEDAY> (funcall *)
End
:FINAL-RESULT

POFTHEDAY> (funcall **)
End
:FINAL-RESULT

That is why it is called "continuation"! Yeah! As you can see, we can call this captured function any amount of times.

Now, let's try to create a function which will interrupt its execution and return a continuation.

Our first attempt might be like this:

POFTHEDAY> (defun foo ()
             (cont:with-call/cc
               (format t "Begin foo~%")
               (cont:let/cc k
                 (format t "Before returning k from foo~%")
                 k)
               (format t "End foo~%")
               :final-result))

POFTHEDAY> (cont:with-call/cc
             (format t "Before foo~%")
             (foo)
             (format t "After foo~%"))
Before foo
Begin foo
Before returning k from foo
After foo ;; Ups! I've expected it will not output this
NIL       ;; and return a continuation function instead of NIL!

As you can see, only half of our function was executed and then control flow continued, printed "After foo" and finished without giving us any continuation to play with :(

To make this code work as expected, we need to move with-call/cc form and make it wrap the function definition:

POFTHEDAY> (cont:with-call/cc
             (defun foo-wrapped ()
               (format t "Begin foo~%")
               (cont:let/cc k
                 (format t "Before returning k from foo~%")
                 k)
               (format t "End foo~%")
               :final-result))


POFTHEDAY> (cont:with-call/cc
             (format t "Before foo~%")
             (foo-wrapped)
             (format t "After foo~%"))
Before foo
Begin foo
Before returning k from foo
#<CLOSURE (LAMBDA (&OPTIONAL #:G1561 &REST #:G1562)) {10067F637B}>

This version works exactly as I've expected. It halts execution inside the foo's call and returns this continuation.

Now we can call continuation to continue computation of the foo function and the rest of our top-level form:

POFTHEDAY> (funcall *)
End foo
After foo
NIL

The latter case works because cont:with-call/cc is smart enough and if it wraps the function foo-wrapped into a special funcallable object:

;; This function is usual:
POFTHEDAY> (fdefinition 'foo)
#<FUNCTION FOO>

;; But this one is not.
;; It supports nested continuations:
POFTHEDAY> (fdefinition 'foo-wrapped)
#<CL-CONT::FUNCALLABLE/CC {10063435FB}>

Now let's adapt some examples from this Wikipedia article about continuations. The first example shows how to save continuation into the global variable and what happens when you use the same function to create the second continuation:

POFTHEDAY> (defvar *the-continuation*)

POFTHEDAY> (cont:defun/cc test ()
             (let ((i 0))
               ;; let/cc binds to k symbol a variable representing
               ;; this point in the program as the argument to
               ;; that function.
               ;;
               ;; In this case, we assigns that
               ;; continuation to the variable *the-continuation*
               ;; and then return the incremented value of 'i'.
               ;;
               (cont:let/cc k
                 (setf *the-continuation* k)
                 (incf i))

               ;; The next time *the-continuation* is called,
               ;; we start here:
               (incf i)))

POFTHEDAY> (test)
1

POFTHEDAY> (funcall *the-continuation*)
2

POFTHEDAY> (funcall *the-continuation*)
3

;; Stores the current continuation (which will print 4 next) away
POFTHEDAY> (defparameter *another-continuation* *the-continuation*)

;; Resets *the-continuation*:
POFTHEDAY> (test)
1

POFTHEDAY> (funcall *the-continuation*)
2

;; Uses the previously stored continuation:
POFTHEDAY> (funcall *another-continuation*)
4

The second example is more interesting because it let us create a simple framework for running green threads.

First, we need to define such two primitives: fork and yield:

POFTHEDAY> (defparameter *queue* nil)

POFTHEDAY> (defun empty-queue? ()
             (null *queue*))

POFTHEDAY> (defun enqueue (func)
             (setf *queue*
                   (append *queue*
                           (list func))))

POFTHEDAY> (defun dequeue ()
             (pop *queue*))

;; This stops running the current thread by placing it into the queue
;; and starts running a (func).
POFTHEDAY> (cont:defun/cc fork (func &rest args)
             (cont:let/cc k
               (enqueue k)
               (apply func args)))

;; This stops running the current thread by placing it into the queue
;; and starts running the other thread from the queue if there is any:
POFTHEDAY> (cont:defun/cc yield ()
             (cont:let/cc k
               (enqueue k)
               (funcall (dequeue))))

How does fork function work?

;; This is the function we want to run in "parallel":
POFTHEDAY> (defun do-job ()
             (format t "Inside job~%"))

;; Initially, our queue is empty:
POFTHEDAY> *queue*
NIL

;; Now when we'll call the fork,
;; it will:
;;
;; - capture current continuation;
;; - put it into the queue;
;; - execute do-job function.
POFTHEDAY> (cont:with-call/cc
             (format t "Before fork~%")
             (fork #'do-job)
             (format t "After fork~%"))
Before fork
Inside job
NIL

;; Now queue has one function which is
;; the rest of our initial computation.
POFTHEDAY> *queue*
(#<FUNCTION (LAMBDA (&OPTIONAL #:G1655 &REST #:G1656)) {22A1719B}>)

;; When the rest of the computation gets called,
;; it prints "After fork" and exits:
POFTHEDAY> (funcall (dequeue))
After fork
NIL

Yield works similarly. It captures the current continuation, appends it to the queue, takes the next coroutine from the top of the queue and executes it.

To test how two coroutines will behave when running in parallel, let's create a function which will print its name in the loop. On each iteration a coroutine will call yield to give other coroutines a chance to get executed:

POFTHEDAY> (cont:defun/cc do-stuff-n-print (name)
             (loop for n from 1 upto 3
                   do (format t "~A ~A~%" name n)
                      (yield)
                      (sleep 1)))

;; We also need to add this primive to our framework
POFTHEDAY> (defun wait-for-threads ()
             (loop
               when (empty-queue?)
                 return nil
               do (funcall (dequeue))))

POFTHEDAY> (cont:with-call/cc
             (fork #'do-stuff-n-print "Foo")
             (fork #'do-stuff-n-print "Bar")
             (wait-for-threads))
Foo 1
Bar 2
Foo 3
Bar 1
Foo 2
Bar 3

The result we've got is the same as the result of the Wikipedia article. Messages from both coroutines are interleaving. That is great!

Now, cl-cont does not look so strange to me. It is time to reimplement continuation widgets for the Weblocks! :)


Brought to you by 40Ants under Creative Commons License