[cl-stm-devel] Cell example

[Hoan Ton-That]

Hey everyone,

Substantial progress has been made since I last
mailed.  We no longer need special macros like
`progt', `progt1' and `tif'.  There is a code walker
which lifts LISP forms into the STM monad.

I'll guide you through the example of a concurrent
mutable cell, and its expansions.  A cell is a mutable
location that is either empty or full with a value.  Its
the same as an MVar in Haskell.  [1]

First off here is the class definition.  We have to
distinguish between empty and full, hence the gensym.

(defparameter *empty-cell* (gensym "EMPTY"))

(deftclass cell ()
  ((value :accessor value-of
          :initarg :value
          :initform *empty-cell*)))

Now here is the interface to tell if the cell is empty:

(deftransaction empty? ((cell cell))
  (eq (value-of cell) *empty-cell*))

The macro expansion for this transaction is:

(PROGN (EVAL-ALWAYS (PUSHNEW 'EMPTY? *TRANS-FUNS*))
       (DEFMETHOD EMPTY? ((CELL CELL))
         (TRANS (EQ (VALUE-OF CELL) *EMPTY-CELL*)))
       'EMPTY?)

Notice that the `eq' is wrapped around with a `trans'.
So `empty?' returns a transaction, that when executed
returns whether or not the cell is empty.

Likewise the transaction `empty!' makes the cell empty.

(deftransaction empty! ((cell cell))
  (setf (value-of cell) *empty-cell*))

Its macroexpansion is similar to `empty?'s:

(PROGN (EVAL-ALWAYS (PUSHNEW 'EMPTY! *TRANS-FUNS*))
       (DEFMETHOD EMPTY! ((CELL CELL))
         (TRANS (LET ((#:G907 CELL))
                  (FUNCALL #'(SETF VALUE-OF) *EMPTY-CELL* #:G907))))
       'EMPTY!)

The `setf' is expanded by the code walker.  Now lets
move onto some more complex transactions.

`take' blocks when the cell is empty, waiting for it
to be filled.  When the cell is filled, `take' returns
the value in the cell, and then empties it.

(deftransaction take ((cell cell))
  (if (empty? cell)
      (retry)
      (prog1 (value-of cell)
        (empty! cell))))

The above code reflects the intent of `take' very
well.  The macroexpansion is:

(PROGN (EVAL-ALWAYS (PUSHNEW 'TAKE *TRANS-FUNS*))
       (DEFMETHOD TAKE ((CELL CELL))
         (TRANS (IF (UNTRANS (EMPTY? CELL))
                    (UNTRANS (RETRY))
                    (LET ((#:G908 (VALUE-OF CELL)))
                      (UNTRANS (EMPTY! CELL))
                      #:G908))))
       'TAKE)

Like before, the body of the `defmethod' is wrapped up
in a `trans'.  But if you look closely, you can see a few
`untrans' forms.  Why are they necessary?  Remember
the `empty?', `retry' and `empty!' return transactions, not
values.  So we have to execute them to get a result.
If there were no `untrans' forms, the `if' would always be
non-nil and the transaction would return a transaction
that retries.  Quite useless.

The code-walker keeps track of which LISP forms return
transactions.  In the macroexpansion of `deftransaction'
there is a `pushnew' which adds it to the list of transactions.

`put' blocks when the cell is full, waiting for it to become
empty.  When its empty, it writes a value in.

(deftransaction put ((cell cell) val)
  (if (not (empty? cell))
      (retry)
      (setf (value-of cell) val)))

The corresponding macroexpansion is:

(PROGN (EVAL-ALWAYS (PUSHNEW 'PUT *TRANS-FUNS*))
       (DEFMETHOD PUT ((CELL CELL) VAL)
         (TRANS (IF (NOT (UNTRANS (EMPTY? CELL)))
                    (UNTRANS (RETRY))
                    (LET ((#:G904 CELL))
                      (FUNCALL #'(SETF VALUE-OF) VAL #:G904)))))
       'PUT)

There is still more to be done on the code walker though.
It doesn't work correctly for transactions that take transactions
as arguments.  So that means it won't walk `orelse' correctly.

Here is a non-blocking version of `put'.  If `try-put' can't put
`val' in `cell' immediately, it returns nil and exits.  If the value
was put without failure, it returns t.

(deftransaction try-put ((cell cell) val)
  (try (progn (put cell val)
              t)
       nil))

The macroexpansion for this is currently:

(PROGN (EVAL-ALWAYS (PUSHNEW 'TRY-PUT *TRANS-FUNS*))
       (DEFMETHOD TRY-PUT ((CELL CELL) VAL)
         (ORELSE (PROGN (UNTRANS (PUT CELL VAL)) T) NIL))
       'TRY-PUT)

The arguments to `orelse' should be wrapped in a `trans'.
So the correct expansion would look like this:

(defmethod try-put ((cell cell) val)
  (orelse (trans
           (progn (untrans (put cell val))
                  t))
          (trans nil)))

This involves finding out the types of the arguments
that transactions take at compile time.  My plan is to
have it extracted from the `deftransaction' definitions.

There are also working examples of a concurrent queue
(the equivalent of Java's ArrayBlockingQueue[2]), and
multicast channels.  [1]

Hoan

[1]  Composable Memory Transactions
(http://research.microsoft.com/~simonpj/papers/stm/stm.pdf)
[2]  Lock Free Data Structures using STM in Haskell
(http://research.microsoft.com/~tharris/papers/2006-flops.pdf)