Re: Using "internal" macros of a CL implementation


Cleaned up a little:

(defun mklist (o)
(if (consp o) o (list o)))

#-lispworks
(defmacro when-let ((var clause) &body body)
`(let ((,var ,clause))
(when ,var
,@body)))

#+lispworks
(import 'lispworks:when-let)

(defmacro generic-ecase (keyform test-fn &body clauses)
(when (assoc t clauses)
(error "GENERIC-ECASE already has a T clause"))
`(generic-case ,keyform ,test-fn
,@clauses
(t (error "~S fell through ECASE; expected one of ~S"
,keyform ',(loop for clause in clauses
if (consp (car clause))
appending (car clause)
else
appending (list (car clause)))))))

(defmacro generic-case (keyform test-fn &body clauses)
(let ((x (gensym)))
`(let ((,x ,keyform))
(cond ,@(loop for (vals . code) in clauses
unless (eq vals t)
collect `((or ,@(loop for val in (mklist vals)
collect `(,test-fn ,x ',val)))
,@code))
,@(when-let (t-clause (assoc t clauses))
(list t-clause))))))

(defmacro case-string-equal (keyform &body clauses)
`(generic-case ,keyform string-equal ,@clauses))

(defmacro ecase-string-equal (keyform &body clauses)
`(generic-ecase ,keyform string-equal ,@clauses))

(defmacro case-string (keyform &body clauses)
`(generic-case ,keyform string= ,@clauses))

(defmacro ecase-string (keyform &body clauses)
`(generic-ecase ,keyform string= ,@clauses))

---

Now you can use GENERIC-CASE as a macro on its own (the old version
used a function BUILD-CASE, so that a new macro had to be defined every
time you wanted a new kind of case). So you can do:

(generic-case #\a char-equal
(#\A 'foo))

(generic-ecase #\a char-equal
(#\A 'foo))

or something similar.
.