Re: Using "internal" macros of a CL implementation



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
.



Relevant Pages

  • Re: Calculate the string statement
    ... verkn:(vkn:char; ... funkt:(fkt:string; ... var fkt,dfkt: p; ... var fehler: boolean; ...
    (comp.lang.pascal.borland)
  • Two new tests for MM B&V
    ... var RunningThreads: Integer; ... class function TStringThreadTest.GetBenchmarkDescription: string; ... function CheckPattern(const Dest: Pointer; const Size: Integer; const ...
    (borland.public.delphi.language.basm)
  • server-side JavaScript: Prototypes of built-in classes, objects and functins
    ... Session object (disk-based session variables for data persistence ... File class (manipulation of files on server, ie. open, close, read, ... //Methods Cgi.queryCgi.postCgi.anyby default return an empty string if requested var not found ...
    (comp.lang.javascript)
  • Re: [PHP] Image Generation
    ... the text, font, colour, maximum frame size (ie the width and height it ... var $xoffset, $yoffset, $margin; ... a string or array of strings. ... a float or an array of floats - which size to display the related text at. ...
    (php.general)
  • Ajax -> javascript edit box display problems - please help
    ... Public Function GetUsernameList(ByVal testParam As String) As String ... getItem: function{ ... getLength: function{ ... var v = this.getValue); ...
    (comp.lang.javascript)