CL-Cont, originally by Slava Akhmechet, shows what code looks like when it’s crying out for functional collections. Some relevant snippets:
(defstruct (call/cc-context (:conc-name ctx-))
"A structure that represents a context used during call/cc
transformation."
(block-tags (make-hash-table))
(go-tags (make-hash-table))
(local-functions nil))
(defun copy-hash-table (ht)
"Shallow hashtable copy."
(let ((nht (make-hash-table :size (hash-table-size ht))))
(maphash (lambda (key value)
(setf (gethash key nht) value))
ht)
nht))
(defun copy-transformation-context (ctx)
"Copies transformation context. This is used for cases when the
context has to be 'frozen' in time and used at a later transformation
stage."
(let ((transf-env (copy-structure ctx)))
(setf (ctx-block-tags transf-env) (copy-hash-table (ctx-block-tags transf-env))
(ctx-go-tags transf-env) (copy-hash-table (ctx-go-tags transf-env))
(ctx-local-functions transf-env) (copy-list (ctx-local-functions transf-env)))
transf-env))
It’s not at all unusual for compiler-related code, which walks a tree maintaining environments mapping names to something, to be naturally expressed using persistent functional collections; and we see a clear example of that here. Anytime you find yourself copying hash tables, you would probably be happier using a functional map.
Here’s some more CL-Cont code (with some less-relevant parts omitted):
(defcpstransformer block (cons k-expr env)
;; [...]
(let ((k (gensym)))
(unwind-protect
(progn
(push k (gethash (cadr cons) (ctx-block-tags *ctx*)))
`(let ((,k ,k-expr))
(declare (ignorable ,k))
,(expr-sequence->cps (cddr cons) k env)))
(pop (gethash (cadr cons) (ctx-block-tags *ctx*))))))
(defcpstransformer return-from (cons k-expr env)
;; [...]
(expr->cps (caddr cons) (or (car (gethash (cadr cons) (ctx-block-tags *ctx*)))
(error "There is no block named ~A" (cadr cons)))
env))
The context is passed via special variable *ctx*. (I don’t recommend the use of a special
variable here — better to make it an explicit parameter of the functions that reference it — but
let’s leave that aside.) The code uses unwind-protect to retract changes to the context on
exiting a scope; this idiom is used in two other places. The function
copy-transformation-context that we saw above is used to package a snapshot of the context
into a form invoking macro transform-forms-in-env, so that a subsequent expansion of this
form will restart the transformation process using the captured context. With persistent functional
collections, neither the unwind-protect nor the copy is necessary.
Here’s what I would do to clean this up with FSet.
First, delete the code in the first example box above: the defstruct of call/cc-context,
along with functions copy-hash-table and copy-transformer-context.
Then replace those definitions with these:
;;; Block-tags and go-tags are maps from names to continuation expressions. (define-tuple-key +ctx-block-tags+ :default (map)) (define-tuple-key +ctx-go-tags+ :default (map)) ;;; Local-functions is just a set of function names locally bound. (define-tuple-key +ctx-local-functions+ :default (set)) (defun make-call/cc-context () (tuple))
Second, replace the transformer definitions shown above for block and return-from with
these:
(defcpstransformer block (cons k-expr env)
;; [...]
(let ((k (gensym))
(*ctx* *ctx*))
(setf (@ (@ *ctx* +ctx-block-tags+) (cadr cons)) k)
`(let ((,k ,k-expr))
(declare (ignorable ,k))
,(expr-sequence->cps (cddr cons) k env))))
(defcpstransformer return-from (cons k-expr env)
;; [...]
(expr->cps (caddr cons) (or (@ (@ *ctx* +ctx-block-tags+) (cadr cons))
(error "There is no block named ~A" (cadr cons)))
env))
Third, make similar changes to the two other places where unwind-protect is being used.
And fourth and finally, simply replace calls to copy-transformer-context by their argument.