Hello,
I have written some macros, I will appreciate if some one can comment on the
style and correctness of these. With whatever limited testing I have done the
macros work, but are there some hidden bugs in them, for example variable
capture, or can this be done in a better way?
If I have a code like
(define-menu-bar my-menu-bar (+mb-dockable+)
("&File" (string +id-open+ "&Open" :help-String "Open")
(string +id-close+ "&Close" :help-string "Close")
(separator)
(string +id-exit+ "&Quit" :help-string "Quit."))
("&Help" (string +id-about+ "&About" :help-string "About")))
then the macro should expand to something which behaves like the following:
A function equivalent to as shown below should be created
(lambda ()
(let ((file-menu (make-menu)) ;;whatever-name, don't care
((help-menu (make-menu))))
(append-string file-menu +id-open+ "&open" :help-string "open")
(append-string file-menu +id-close+ "&close" :help-string "close")
(append-separator file-menu)
(append-string file-menu +id-exit+ "&quit" :help-string "quit.")
(append-string help-menu +id-about+ "&about" :help-string "about")
(setq my-menu-bar
(make-menu-bar (list file-menu help-menu) (list "&file" "&help")
+mb-dockable+))))
Then this function should be added to the variable *function-list*,i.e.,
pair of (my-menu-bar . (lambda ....)) should be added. If my-menu-bar already
exists then its old definition should be overridden.
The macros and functions written below don't exactly generate the above code,
but the code should be equivalent.
(setq *function-list* nil)
(defun assoc-insert (key data alist)
(if (assoc key alist)
(progn (rplacd (assoc key alist) data) alist)
(acons key data alist)))
(defmacro make-menu-with-items (&rest items)
(let ((menu (gensym)))
`(let ((,menu (make-menu)))
,@(loop for (type . params) in items collect
(case type
(string `(append-string ,menu ,@params))
(separator `(append-separator ,menu))
(check-item `(append-check-item ,menu ,@params))
(radio-item `(append-radio-item ,menu ,@params))
(sub-menu `(append-sub-menu ,menu ,@params))
(menu-items `(append-sub-menu ,menu ,@params))))
,menu)))
(defmacro define-menu-bar (name options &rest menus)
`(setf *function-list*
(assoc-insert ',name
(lambda ()
,(let (menu-names menu-list)
`(let
,(loop for (menu-name . menu-items) in menus do
(push menu-name menu-names) collect
(let ((menu (gensym)))
(push menu menu-list)
`(,menu (make-menu-with-items ,@menu-items))
))
(setf ,name (make-menu-bar (list ,@(nreverse menu-list))
(list ,@(nreverse menu-names))
,@(when options options))))))
*function-list*)))
Thanks a lot.
--
Surendra Singhi
http://www.public.asu.edu/~sksinghi/index.html
Surendra Singhi <·········@netscape.net> writes:
> Hello,
> I have written some macros, I will appreciate if some one can comment on the
> style and correctness of these. With whatever limited testing I have done the
> macros work, but are there some hidden bugs in them, for example variable
> capture, or can this be done in a better way?
>
> If I have a code like
>
> (define-menu-bar my-menu-bar (+mb-dockable+)
> ("&File" (string +id-open+ "&Open" :help-String "Open")
> (string +id-close+ "&Close" :help-string "Close")
> (separator)
> (string +id-exit+ "&Quit" :help-string "Quit."))
> ("&Help" (string +id-about+ "&About" :help-string "About")))
>
> then the macro should expand to something which behaves like the following:
>
> A function equivalent to as shown below should be created
>
> (lambda ()
> (let ((file-menu (make-menu)) ;;whatever-name, don't care
> ((help-menu (make-menu))))
> (append-string file-menu +id-open+ "&open" :help-string "open")
> (append-string file-menu +id-close+ "&close" :help-string "close")
> (append-separator file-menu)
> (append-string file-menu +id-exit+ "&quit" :help-string "quit.")
> (append-string help-menu +id-about+ "&about" :help-string "about")
> (setq my-menu-bar
> (make-menu-bar (list file-menu help-menu) (list "&file" "&help")
> +mb-dockable+))))
>
> Then this function should be added to the variable *function-list*,i.e.,
> pair of (my-menu-bar . (lambda ....)) should be added. If my-menu-bar already
> exists then its old definition should be overridden.
>
> The macros and functions written below don't exactly generate the above code,
> but the code should be equivalent.
>
> (setq *function-list* nil)
Did you defvar or defparameter *function-list* before?
> (defun assoc-insert (key data alist)
> (if (assoc key alist)
> (progn (rplacd (assoc key alist) data) alist)
> (acons key data alist)))
You could use a hash table:
(defvar *menu-functions* (make-hash-table))
> (defmacro make-menu-with-items (&rest items)
> (let ((menu (gensym)))
> `(let ((,menu (make-menu)))
> ,@(loop for (type . params) in items collect
> (case type
> (string `(append-string ,menu ,@params))
> (separator `(append-separator ,menu))
> (check-item `(append-check-item ,menu ,@params))
> (radio-item `(append-radio-item ,menu ,@params))
> (sub-menu `(append-sub-menu ,menu ,@params))
> (menu-items `(append-sub-menu ,menu ,@params))))
> ,menu)))
There's no reason for it to be a macro. The name should give you a
hint: MAKE-, not DEFINE-.
(defun make-menu-with-items (items)
> (defmacro define-menu-bar (name options &rest menus)
> `(setf *function-list*
> (assoc-insert ',name
> (lambda ()
> ,(let (menu-names menu-list)
> `(let
> ,(loop for (menu-name . menu-items) in menus do
> (push menu-name menu-names) collect
> (let ((menu (gensym)))
> (push menu menu-list)
> `(,menu (make-menu-with-items ,@menu-items))
> ))
> (setf ,name (make-menu-bar (list ,@(nreverse menu-list))
> (list ,@(nreverse menu-names))
> ,@(when options options))))))
> *function-list*)))
You're assigning to ,name without defvar or defparameter it!
It's customary for define macros to return the name defined; return: ',name
Perhaps make-menu-bar could be called at macro expansion time?
Do you need to evaluate the elements in menu-list, menu-names and options?
If that's what you want, then it's all right, otherwise you could write:
`(make-menu-bar ',(nreverse menu-list)
',(nreverse menu-names)
',options)
;; to evaluate make-menu-bar at run-time,
;; without evaluating the elements in menu-list, menu-names and options.
or:
,(make-menu-bar (nreverse menu-list)
(nreverse menu-names)
options)
;; to evaluate make-menu-bar at macroexpansion-time,
;; without evaluating the elements in menu-list, menu-names and options.
(defparameter y 42)
(defparameter x '((+ 1 2) y "Hi"))
`(list ,@x) --> (LIST (+ 1 2) Y "Hi") ; to get (3 42 "Hi")
`',x --> '((+ 1 2) Y "Hi") ; to get ((+ 1 2) y "Hi")
--
__Pascal Bourguignon__ http://www.informatimago.com/
Litter box not here.
You must have moved it again.
I'll poop in the sink.
Pascal Bourguignon <····@mouse-potato.com> writes:
> Surendra Singhi <·········@netscape.net> writes:
>
>> Hello,
>> I have written some macros, I will appreciate if some one can comment on the
>> style and correctness of these. With whatever limited testing I have done the
>> macros work, but are there some hidden bugs in them, for example variable
>> capture, or can this be done in a better way?
>>
>> If I have a code like
>>
>> (define-menu-bar my-menu-bar (+mb-dockable+)
>> ("&File" (string +id-open+ "&Open" :help-String "Open")
>> (string +id-close+ "&Close" :help-string "Close")
>> (separator)
>> (string +id-exit+ "&Quit" :help-string "Quit."))
>> ("&Help" (string +id-about+ "&About" :help-string "About")))
>>
>> then the macro should expand to something which behaves like the following:
>>
>> A function equivalent to as shown below should be created
>>
>> (lambda ()
>> (let ((file-menu (make-menu)) ;;whatever-name, don't care
>> ((help-menu (make-menu))))
>> (append-string file-menu +id-open+ "&open" :help-string "open")
>> (append-string file-menu +id-close+ "&close" :help-string "close")
>> (append-separator file-menu)
>> (append-string file-menu +id-exit+ "&quit" :help-string "quit.")
>> (append-string help-menu +id-about+ "&about" :help-string "about")
>> (setq my-menu-bar
>> (make-menu-bar (list file-menu help-menu) (list "&file" "&help")
>> +mb-dockable+))))
>>
>> Then this function should be added to the variable *function-list*,i.e.,
>> pair of (my-menu-bar . (lambda ....)) should be added. If my-menu-bar already
>> exists then its old definition should be overridden.
>>
>> The macros and functions written below don't exactly generate the above code,
>> but the code should be equivalent.
>>
>> (setq *function-list* nil)
>
> Did you defvar or defparameter *function-list* before?
>
Nope, I should do that.
>
>> (defmacro make-menu-with-items (&rest items)
>> (let ((menu (gensym)))
>> `(let ((,menu (make-menu)))
>> ,@(loop for (type . params) in items collect
>> (case type
>> (string `(append-string ,menu ,@params))
>> (separator `(append-separator ,menu))
>> (check-item `(append-check-item ,menu ,@params))
>> (radio-item `(append-radio-item ,menu ,@params))
>> (sub-menu `(append-sub-menu ,menu ,@params))
>> (menu-items `(append-sub-menu ,menu ,@params))))
>> ,menu)))
>
> There's no reason for it to be a macro. The name should give you a
> hint: MAKE-, not DEFINE-.
>
Thanks, I should rename the macro.
> (defun make-menu-with-items (items)
>
>> (defmacro define-menu-bar (name options &rest menus)
>> `(setf *function-list*
>> (assoc-insert ',name
>> (lambda ()
>> ,(let (menu-names menu-list)
>> `(let
>> ,(loop for (menu-name . menu-items) in menus do
>> (push menu-name menu-names) collect
>> (let ((menu (gensym)))
>> (push menu menu-list)
>> `(,menu (make-menu-with-items ,@menu-items))
>> ))
>> (setf ,name (make-menu-bar (list ,@(nreverse menu-list))
>> (list ,@(nreverse menu-names))
>> ,@(when options options))))))
>> *function-list*)))
>
> You're assigning to ,name without defvar or defparameter it!
Should, I defvar the name in the macro?
> It's customary for define macros to return the name defined; return: ',name
>
I will do that as well.
> Perhaps make-menu-bar could be called at macro expansion time?
No, it cannot be because the library is not initialised, till the application
starts, and thats why I am creating a list of functions, so that they can be
called when the application starts.
> Do you need to evaluate the elements in menu-list, menu-names and options?
>
Yes, menu-list, menu-names and options are variables created and used during
macro expansion, so I am evaluating them.
Thanks once again. I appreciate it.
--
Surendra Singhi
http://www.public.asu.edu/~sksinghi/index.html
,----
| "War is Peace! Freedom is Slavery! Ignorance is Strength!"
| -- Orwell, 1984, 1948
`----
Surendra Singhi wrote:
> Hello,
> I have written some macros, I will appreciate if some one can comment on the
> style and correctness of these. With whatever limited testing I have done the
> macros work, but are there some hidden bugs in them, for example variable
> capture, or can this be done in a better way?
[...]
Basically, the code looks quite good. Here are some minor remarks:
> (setq *function-list* nil)
>
> (defun assoc-insert (key data alist)
> (if (assoc key alist)
> (progn (rplacd (assoc key alist) data) alist)
> (acons key data alist)))
I think that's easier with property lists. (setf (getf plist key)
new-value) already updates existing entries in a plist.
> (defmacro make-menu-with-items (&rest items)
> (let ((menu (gensym)))
> `(let ((,menu (make-menu)))
> ,@(loop for (type . params) in items collect
> (case type
> (string `(append-string ,menu ,@params))
> (separator `(append-separator ,menu))
> (check-item `(append-check-item ,menu ,@params))
> (radio-item `(append-radio-item ,menu ,@params))
> (sub-menu `(append-sub-menu ,menu ,@params))
> (menu-items `(append-sub-menu ,menu ,@params))))
> ,menu)))
Here I would use ecase or ccase for added safety.
> (defmacro define-menu-bar (name options &rest menus)
> `(setf *function-list*
> (assoc-insert ',name
> (lambda ()
> ,(let (menu-names menu-list)
> `(let
> ,(loop for (menu-name . menu-items) in menus do
> (push menu-name menu-names) collect
> (let ((menu (gensym)))
> (push menu menu-list)
> `(,menu (make-menu-with-items ,@menu-items))
> ))
> (setf ,name (make-menu-bar (list ,@(nreverse menu-list))
> (list ,@(nreverse menu-names))
> ,@(when options options))))))
> *function-list*)))
The loop is a little bit too complicated for my taste. I would write it
as follows:
(lambda ()
,(loop for (menu-name . menu-items) in menus
for menu = (gensym)
collect menu-name into menu-names
collect menu into menu-list
collect `(,menu (make-menu-with-items
,@menu-items) into bindings
finally
(return
`(let ,bindings
(setf ,name (make-menu-bar (list ,@menu-list)
(list ,@menu-names))
,@(when options options))))))
This is untested, so I can't guarantee that this actually does what you
want...
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
Pascal Costanza <··@p-cos.net> writes:
> Surendra Singhi wrote:
>> Hello,
>> I have written some macros, I will appreciate if some one can comment on the
>> style and correctness of these. With whatever limited testing I have done the
>> macros work, but are there some hidden bugs in them, for example variable
>> capture, or can this be done in a better way?
> [...]
>
> Basically, the code looks quite good. Here are some minor remarks:
>
>> (setq *function-list* nil)
>> (defun assoc-insert (key data alist)
>> (if (assoc key alist)
>> (progn (rplacd (assoc key alist) data) alist)
>> (acons key data alist)))
>
> I think that's easier with property lists. (setf (getf plist key)
> new-value) already updates existing entries in a plist.
Thanks.
>
>> (defmacro make-menu-with-items (&rest items)
>> (let ((menu (gensym)))
>> `(let ((,menu (make-menu)))
>> ,@(loop for (type . params) in items collect
>> (case type
>> (string `(append-string ,menu ,@params))
>> (separator `(append-separator ,menu))
>> (check-item `(append-check-item ,menu ,@params))
>> (radio-item `(append-radio-item ,menu ,@params))
>> (sub-menu `(append-sub-menu ,menu ,@params))
>> (menu-items `(append-sub-menu ,menu ,@params))))
>> ,menu)))
>
> Here I would use ecase or ccase for added safety.
>
>> (defmacro define-menu-bar (name options &rest menus)
>> `(setf *function-list*
>> (assoc-insert ',name
>> (lambda ()
>> ,(let (menu-names menu-list)
>> `(let
>> ,(loop for (menu-name . menu-items) in menus do
>> (push menu-name menu-names) collect
>> (let ((menu (gensym)))
>> (push menu menu-list)
>> `(,menu (make-menu-with-items ,@menu-items))
>> ))
>> (setf ,name (make-menu-bar (list ,@(nreverse menu-list))
>> (list ,@(nreverse menu-names))
>> ,@(when options options))))))
>> *function-list*)))
>
> The loop is a little bit too complicated for my taste. I would write
> it as follows:
>
> (lambda ()
> ,(loop for (menu-name . menu-items) in menus
> for menu = (gensym)
> collect menu-name into menu-names
> collect menu into menu-list
> collect `(,menu (make-menu-with-items
> ,@menu-items) into bindings
> finally
> (return
> `(let ,bindings
> (setf ,name (make-menu-bar (list ,@menu-list)
> (list ,@menu-names))
> ,@(when options options))))))
Thanks, I didn't knew it was possible to use multiple collects. This code is
much easier to understand.
--
Surendra Singhi
http://www.public.asu.edu/~sksinghi/index.html
,----
| "All animals are equal, but some animals are more equal than others."
| -- Orwell, Animal Farm, 1945
`----
Surendra Singhi <·········@netscape.net> wrote:
+---------------
| Pascal Costanza <··@p-cos.net> writes:
...
| > collect menu-name into menu-names
| > collect menu into menu-list
| > collect `(,menu (make-menu-with-items
...
| Thanks, I didn't knew it was possible to use multiple collects.
+---------------
Not only that, but they can be conditional, and you can
even collect the same thing more than once if you need to.
For example:
> (loop for i in (iota 30)
if (oddp i)
collect i into odds
else ; cheaper than "when (evenp i)"
collect i into evens
when (zerop (mod i 3))
collect i into triples
when (zerop (mod i 5))
collect i into fivers
finally (return (values odds evens triples fivers)))
(1 3 5 7 9 11 13 15 17 19 21 23 25 27 29)
(0 2 4 6 8 10 12 14 16 18 20 22 24 26 28)
(0 3 6 9 12 15 18 21 24 27)
(0 5 10 15 20 25)
>
-Rob
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
"Rob Warnock" <····@rpw3.org> wrote in message
·····································@speakeasy.net...
> Surendra Singhi <·········@netscape.net> wrote:
> +---------------
> | Pascal Costanza <··@p-cos.net> writes:
> ...
> | > collect menu-name into menu-names
> | > collect menu into menu-list
> | > collect `(,menu (make-menu-with-items
> ...
> | Thanks, I didn't knew it was possible to use multiple collects.
> +---------------
>
> Not only that, but they can be conditional, and you can
> even collect the same thing more than once if you need to.
> For example:
>
> > (loop for i in (iota 30)
What's this IOTA beast?
--
Coby Beck
(remove #\Space "coby 101 @ bigpond . com")
In article <·······················@clgrps12>,
Coby Beck <·····@mercury.bc.ca> wrote:
> What's this IOTA beast?
Traditionally, something like:
(defun iota (n)
(loop for i below n collect n))
-bcd
--
*** Brian Downing <bdowning at lavos dot net>
Brian Downing <·············@lavos.net> wrote:
+---------------
| Coby Beck <·····@mercury.bc.ca> wrote:
| > What's this IOTA beast?
|
| Traditionally, something like:
| (defun iota (n)
| (loop for i below n collect n))
+---------------
Yup. It seemed obvious, so I neglected to mention it, sorry.
The version in my personal toolbox only a tiny bit more general
than Coby's, and matches versions I have seen elsewhere [though
there is considerable controversy over just what the "right" args
are for IOTA, though I prefer these, obviously]:
(defun iota (count &optional (start 0) (step 1))
(loop repeat count for i from start by step collect i))
It's especially convenient to generate test input data interactively:
(iota 5) ==> (0 1 2 3 4)
(iota 5 7) ==> (7 8 9 10 11)
(iota 5 7 3) ==> (7 10 13 16 19)
(iota 5 2 -1) ==> (2 1 0 -1 -2)
(iota 5 1 0) ==> (1 1 1 1 1)
(coerce (mapcar #'code-char (iota 10 65)) 'string) ==> "ABCDEFGHIJ"
-Rob
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
"Rob Warnock" <····@rpw3.org> wrote in message
···························@speakeasy.net...
> Brian Downing <·············@lavos.net> wrote:
> +---------------
> | Coby Beck <·····@mercury.bc.ca> wrote:
> | > What's this IOTA beast?
> |
> | Traditionally, something like:
> | (defun iota (n)
> | (loop for i below n collect n))
> +---------------
>
> Yup. It seemed obvious, so I neglected to mention it, sorry.
It was obvious what it did, it just seemed likely that it would not be
obvious to the OP or any newbie lurkers that it was not standard or a LOOP
feature or somesuch.
> The version in my personal toolbox only a tiny bit more general
> than Coby's, and matches versions I have seen elsewhere [though
(Brian's)
> there is considerable controversy over just what the "right" args
> are for IOTA, though I prefer these, obviously]:
>
> (defun iota (count &optional (start 0) (step 1))
> (loop repeat count for i from start by step collect i))
Of course all that stuff would fit in very nicely with all your other LOOP
bells and whistles!
(loop for i in (iota 30)
becomes
(loop for i from 0 to 30
or even shorter
(loop for i below 30
if (oddp i)
collect i into odds
else ; cheaper than "when (evenp i)"
collect i into evens
when (zerop (mod i 3))
collect i into triples
when (zerop (mod i 5))
collect i into fivers
finally (return (values odds evens triples fivers)))
I of course should have put more effort into my previous post.
--
Coby Beck
(remove #\Space "coby 101 @ bigpond . com")