Re: Using "internal" macros of a CL implementation
- From: Bill Atkins <atkinw@xxxxxxx>
- Date: Sun, 29 Oct 2006 22:14:32 -0500
Victor Kryukov <victor.kryukov+news@xxxxxxxxx> writes:
Hello group,
I've the following question: I want to define macro case-string, which
behaves exactly like case, only using string-equal instead of eql.
Here is what I use for this sort of thing. It could certainly be
cleaned up, but it's a start:
(defun build-case (test-fn var clauses &key errorp)
(let ((x (gensym)))
`(let ((,x ,var))
(cond ,@(loop for (vals . code) in clauses
if (consp vals)
collect (append `((or
,@(loop for val in vals
collect `(,test-fn ,x ,val))))
code)
else
collect (append (when (and (eq vals t)
(not errorp))
`((,test-fn ,x ,vals)))
code))
,@(if errorp
`((t (error "~S fell through CASE; expected one of ~S"
,var
',(loop for (clause . rest) in clauses
if (consp clause)
append clause
else collect clause)))))))))
(defmacro case-string-equal (var &body clauses)
(build-case 'string-equal var clauses))
(defmacro ecase-string-equal (var &body clauses)
(build-case 'string-equal var clauses :errorp t))
(defmacro case-string (var &body clauses)
(build-case 'string= var clauses))
(defmacro ecase-string (var &body clauses)
(build-case 'string= var clauses :errorp t))
CL-USER 5 > (macroexpand '(ecase-string-equal "foob"
("foo" 3)
(t 4)))
(LET ((#:X16625 "foob")) (COND ((STRING-EQUAL #:X16625 "foo") 3) ((STRING-EQUAL #:X16625 T) 4) (T (ERROR "~S fell through CASE; expected one of ~S" "foob" (QUOTE ("foo" T))))))
T
.
- Follow-Ups:
- Re: Using "internal" macros of a CL implementation
- From: Bill Atkins
- Re: Using "internal" macros of a CL implementation
- References:
- Using "internal" macros of a CL implementation
- From: Victor Kryukov
- Using "internal" macros of a CL implementation
- Prev by Date: Re: Using "internal" macros of a CL implementation
- Next by Date: Efficiency of arrays in LISP
- Previous by thread: Re: Using "internal" macros of a CL implementation
- Next by thread: Re: Using "internal" macros of a CL implementation
- Index(es):
Relevant Pages
|
|