Hi,
I am writing a macro that would create nice wrappers for
SWIG-generated CFFI bindings for Cairo, ie it would
- automatically add *cr* as the first variable, so that the context
wouldn't have to be specified for each function call (*cr* is a global var),
- make any type conversions specified (fixnum -> double-float, vice versa)
- have properly named function args that show up in SLIME, etc
Example:
CL-CAIRO2> (macroexpand-1 '(defcairo-with-context foo cairo_foo a :int b :double c))
(DEFUN FOO (A B C) (CAIRO_FOO *CR* A (ROUND B) (COERCE C 'DOUBLE-FLOAT)))
T
CL-CAIRO2> (macroexpand-1 '(defcairo-with-context rectangle cairo_rectangle
:double x :double y
:double width :double height))
(DEFUN RECTANGLE (X Y WIDTH HEIGHT)
(CAIRO_RECTANGLE *CR*
(COERCE X 'DOUBLE-FLOAT)
(COERCE Y 'DOUBLE-FLOAT)
(COERCE WIDTH 'DOUBLE-FLOAT)
(COERCE HEIGHT 'DOUBLE-FLOAT)))
T
Here is my attempt:
(defmacro defcairo-with-context (name cairo-name &rest type-arg-list)
(do ((tal type-arg-list (cdr tal)) ; type-arg-list
(args nil) ; arguments
(conversion nil)) ; conversion
((null tal) `(defun ,name (,@(nreverse args))
(,cairo-name *cr* ,@(nreverse conversion))))
(let ((head (car tal)))
(if (member head '(:int :double)) ; is there a type specifier?
(let ((name (cadr tal)))
(unless name ; is it followed by an actual argument?
(error "No argument after ~a." (car tal)))
(push name args) ; save argument
(push (case head ; save conversion call
((:int) `(round ,name))
((:double) `(coerce ,name 'double-float)))
conversion)
(setf tal (cdr tal))) ; step ahead (for argument)
(progn (push head args) ; no conversion
(push head conversion))))))
It basically walks down the list of arguments, if finds a type
specifier, it will check if there is an argument that follows and then
write a conversion into the function.
It does the job, but it looks very ugly. Improvements would be
welcome, this is my first non-trivial macro.
Another thing: I would like to make cairo-name an optimal argument,
with the default generated by
(defmacro make-cairo-function-name (name)
(intern (concatenate 'string "CAIRO_"
(substitute #\_ #\- (symbol-name name)))))
I wonder if this is the right way to do it, and how to incorporate it
into the macro.
Thanks,
Tamas
--
Posted via a free Usenet account from http://www.teranews.com
Tamas Papp wrote:
> Hi,
>
> I am writing a macro that would create nice wrappers for
> SWIG-generated CFFI bindings for Cairo, ie it would
>
> - automatically add *cr* as the first variable, so that the context
> wouldn't have to be specified for each function call (*cr* is a global var),
>
> - make any type conversions specified (fixnum -> double-float, vice versa)
>
> - have properly named function args that show up in SLIME, etc
>
> Example:
>
> CL-CAIRO2> (macroexpand-1 '(defcairo-with-context foo cairo_foo a :int b :double c))
>
> (DEFUN FOO (A B C) (CAIRO_FOO *CR* A (ROUND B) (COERCE C 'DOUBLE-FLOAT)))
> T
> CL-CAIRO2> (macroexpand-1 '(defcairo-with-context rectangle cairo_rectangle
> :double x :double y
> :double width :double height))
>
> (DEFUN RECTANGLE (X Y WIDTH HEIGHT)
> (CAIRO_RECTANGLE *CR*
> (COERCE X 'DOUBLE-FLOAT)
> (COERCE Y 'DOUBLE-FLOAT)
> (COERCE WIDTH 'DOUBLE-FLOAT)
> (COERCE HEIGHT 'DOUBLE-FLOAT)))
> T
>
> Here is my attempt:
>
> (defmacro defcairo-with-context (name cairo-name &rest type-arg-list)
> (do ((tal type-arg-list (cdr tal)) ; type-arg-list
> (args nil) ; arguments
> (conversion nil)) ; conversion
> ((null tal) `(defun ,name (,@(nreverse args))
> (,cairo-name *cr* ,@(nreverse conversion))))
> (let ((head (car tal)))
> (if (member head '(:int :double)) ; is there a type specifier?
> (let ((name (cadr tal)))
> (unless name ; is it followed by an actual argument?
> (error "No argument after ~a." (car tal)))
> (push name args) ; save argument
> (push (case head ; save conversion call
> ((:int) `(round ,name))
> ((:double) `(coerce ,name 'double-float)))
> conversion)
> (setf tal (cdr tal))) ; step ahead (for argument)
> (progn (push head args) ; no conversion
> (push head conversion))))))
>
> It basically walks down the list of arguments, if finds a type
> specifier, it will check if there is an argument that follows and then
> write a conversion into the function.
>
> It does the job, but it looks very ugly.
Macros tend to look hairy.
> Improvements would be
> welcome, this is my first non-trivial macro.
Use loop. And normalize the arg list as a separate step to divide and
conquer complexity:
(defmacro defcairo-with-context (name cairo-name &rest type-arg-list)
(loop for (type name) in (loop with type
for input in type-arg-list
if (find input '(:int :double))
do (setf type input)
else collect (list type input)
and do (setf type nil))
collect name into args
when type
collect (case type
((:int) `(round ,name))
((:double) `(coerce ,name 'double-float)))
into conversions
finally (return
`(defun ,name (,@args)
(,cairo-name *cr* ,@conversion)))))
Exhaustively untested.
You can add error-checking back into the normalization pass pretty
easily, I think.
>
> Another thing: I would like to make cairo-name an optimal argument,
> with the default generated by
>
> (defmacro make-cairo-function-name (name)
> (intern (concatenate 'string "CAIRO_"
> (substitute #\_ #\- (symbol-name name)))))
>
> I wonder if this is the right way to do it,
Looks reasonable, except I think you meant that to be a defun. It should
be anyway.
> and how to incorporate it
> into the macro.
Cut and paste? I do not see the problem.
kzo
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
Ken Tilton wrote:
>
>
> Tamas Papp wrote:
>
>> Hi,
>>
>> I am writing a macro that would create nice wrappers for
>> SWIG-generated CFFI bindings for Cairo, ie it would
>>
>> - automatically add *cr* as the first variable, so that the context
>> wouldn't have to be specified for each function call (*cr* is a
>> global var),
>>
>> - make any type conversions specified (fixnum -> double-float, vice
>> versa)
>>
>> - have properly named function args that show up in SLIME, etc
>>
>> Example:
>>
>> CL-CAIRO2> (macroexpand-1 '(defcairo-with-context foo cairo_foo a :int
>> b :double c))
>>
>> (DEFUN FOO (A B C) (CAIRO_FOO *CR* A (ROUND B) (COERCE C 'DOUBLE-FLOAT)))
>> T
>> CL-CAIRO2> (macroexpand-1 '(defcairo-with-context rectangle
>> cairo_rectangle :double x :double y :double
>> width :double height))
>>
>> (DEFUN RECTANGLE (X Y WIDTH HEIGHT)
>> (CAIRO_RECTANGLE *CR*
>> (COERCE X 'DOUBLE-FLOAT)
>> (COERCE Y 'DOUBLE-FLOAT)
>> (COERCE WIDTH 'DOUBLE-FLOAT)
>> (COERCE HEIGHT 'DOUBLE-FLOAT)))
>> T
>>
>> Here is my attempt:
>>
>> (defmacro defcairo-with-context (name cairo-name &rest type-arg-list)
>> (do ((tal type-arg-list (cdr tal)) ; type-arg-list
>> (args nil) ; arguments
>> (conversion nil)) ; conversion
>> ((null tal) `(defun ,name (,@(nreverse args))
>> (,cairo-name *cr* ,@(nreverse conversion))))
>> (let ((head (car tal)))
>> (if (member head '(:int :double)) ; is there a type specifier?
>> (let ((name (cadr tal)))
>> (unless name ; is it followed by an actual argument?
>> (error "No argument after ~a." (car tal)))
>> (push name args) ; save argument
>> (push (case head ; save conversion call
>> ((:int) `(round ,name))
>> ((:double) `(coerce ,name 'double-float)))
>> conversion)
>> (setf tal (cdr tal))) ; step ahead (for argument)
>> (progn (push head args) ; no conversion
>> (push head conversion))))))
>>
>> It basically walks down the list of arguments, if finds a type
>> specifier, it will check if there is an argument that follows and then
>> write a conversion into the function.
>>
>> It does the job, but it looks very ugly.
>
>
> Macros tend to look hairy.
>
>> Improvements would be
>> welcome, this is my first non-trivial macro.
>
>
> Use loop. And normalize the arg list as a separate step to divide and
> conquer complexity:
>
> (defmacro defcairo-with-context (name cairo-name &rest type-arg-list)
> (loop for (type name) in (loop with type
> for input in type-arg-list
> if (find input '(:int :double))
> do (setf type input)
> else collect (list type input)
> and do (setf type nil))
> collect name into args
> when type
> collect (case type
> ((:int) `(round ,name))
> ((:double) `(coerce ,name 'double-float)))
> into conversions
> finally (return
> `(defun ,name (,@args)
> (,cairo-name *cr* ,@conversion)))))
Oops, lost some args in passing, perhaps because of the name
conversions. And now that normalizing looks so simple, no need to have
it separate:
(defmacro defcairo-with-context (name cairo-name &rest type-arg-list)
(loop with type
for ta in type-arg-list
if (find ta '(:int :double))
do (setf type ta)
else collect ta into fn-params
and collect (case type
((:int) `(round ,ta))
((:double) `(coerce ,ta 'double-float))
(otherwise ta)) into passed-args
and do (setf type nil)
finally (return
`(defun ,name (,@fn-params)
(,cairo-name *cr* ,@passed-args)))))
Syntax checking still left as an... aw, shucks:
(defmacro defcairo-with-context (name cairo-name &rest type-arg-list)
(loop with type
for ta in type-arg-list
if (find ta '(:int :double))
do
(assert (not type) () "Two types in a row: ~a and ~a" type ta)
(setf type ta)
else if (keywordp ta) do (break "Unknown type ~a" ta)
else collect ta into fn-params
and collect (prog1
(case type
((:int) `(round ,ta))
((:double) `(coerce ,ta 'double-float))
(otherwise ta))
(setf type nil)) into passed-args
finally
(assert (not type) () "Trailing type, no arg: ~a" type)
(return
`(defun ,name (,@fn-params)
(,cairo-name *cr* ,@passed-args)))))
kt