How do I turn a list argument to a macro into a heavily modified but quoted list as a result?
I translated into Lisp John Foster's example for converting win32 WM_* messages into helpful text. Convert Windows Message IDs to Text
I needed to define the win32 constants and a macro seemed perfect for calling (defconstant WM_PAINT 15) and registering WM_PAINT and "WM_PAINT" automatically.
Working Test Code:
(defmacro def-windows-message (&rest rest )
"Converts a list of windows messages into defconstant and a string lookup in GetMessageText."
`(block nil
,@(loop for pair in rest collect
`(defconstant ,(car pair) ,(cadr pair)))
(defparameter *windows-message-lookup* #(
,@(loop for pair in rest collect (cons (cadr pair) (string (car pair) )))
))
(defun GetMessageText (id)
(destructuring-bind (index text)
(msgid_to_index id *windows-message-lookup* 0 (length *windows-message-lookup*))
(if (= index -1)
(format nil "(WM_? ~a)" id)
; else
text)))
(defun msgid_to_index (target_id array min_idx max_idx)
(let* ( (cur_idx (floor (/ (+ max_idx min_idx) 2)))
(cur_pair (aref array cur_idx))
(cur_id (car cur_pair))
(cur_text (cdr cur_pair)))
(cond
((= target_id cur_id) (list cur_idx cur_text))
((> target_id cur_id)
(if (= cur_idx min_idx)
'(-1 nil)
; else
(msgid_to_index target_id array cur_idx max_idx)))
((< target_id cur_id)
(if (= cur_idx max_idx)
'(-1 nil)
;else
(msgid_to_index target_id array min_idx cur_idx)))
)
)
)
))
; Test it!
(def-windows-message
(WM_NULL 0)
(WM_CREATE 1))
(format t "~a~%" (GetMessageText 0))
(format t "~a~%" (GetMessageText 1))
(format t "~a~%" (GetMessageText -1))
(format t "~a~%" (GetMessageText 99))
Working Output:
C:\lisphack>clisp test_macro_long_list.lisp
WM_NULL
WM_CREATE
(WM_? -1)
(WM_? 99)
Excellent. That's exactly what I want.
However, when I add 240 more windows messages to the list, it fails.
Long List Failure Output: *** - VALUES-LIST: too many return values
This message means that too many function parameters are being passed to the #() function.
I finally just create the array empty and then loop through the list inserting each element into teh array.
Working but gross snippet:
(defparameter *windows-message-looup* (make-array ,(length rest) :initial-element '(-1 Nil)))
,@(loop for pair in rest for idx from 0 collect `(setf (aref *windows-message-lookup* ,idx) (cons ,(cadr pair) ,(string (car pair) ))))
What I really want is to convert the &rest list into the proper form, then send that list into the array constructor as initial values:
Elegant but flawed
(defparameter *windows-message-lookup* (make-array ,(length rest)
,@(loop for pair in rest collect (cons (cadr pair) (string (car pair) )))
Error: *** - EVAL: 0 is not a function name; try using a symbol instead
I think that means the eventual parameter to make-array is being executed instead of quoted as an initializer.
I need one extra quote on the resulting list. One More Quote
(defparameter *windows-message-lookup* (make-array ,(length rest)
`,@(loop for pair in rest collect ,(cons (cadr pair) (string (car pair) )))))
Error: *** - READ: the syntax ,@form is invalid`
I've tried a few variations adding extra backquotes or moving the parenthesis around, but they result in a list of my list or the argument pairs executing instead of reading.
[EDITED] Thank-you. This looks better than what I was attempting. For my education, what's the correct form of this macro?
(defmacro def-windows-message (&rest rest )
`(defparameter *windows-message-lookup*
(make-array
,(length rest)
`(,@(loop for pair in rest collect ,(cons (cadr pair) (string (car pair) )))))))
For an input of (def-windows-message '((onefish 1) (twofish 2) .. ))
I want (make-array 999 '( (onefish "onefish") (twofish "twofish") ... )) as the result.
I'm having trouble with correctly quoting the resulting list and still processing it in the macro.
I tried to understand what this macro was doing but gave up when I realised it's using binary search on an array to find the message. This is why translating C into Lisp is almost never the right answer.
I am not completely sure but I think you probably want this:
(defvar *windows-message-lookup*
;; Unless you have vast numbers of messages (thousands) and/or the
;; code is very performance sensitive, this could as well be an
;; alist
(make-hash-table))
(defmacro def-windows-messages (&body messages)
"Define a bunch of windows messages, each message is (name id)"
`(progn
,@(loop for (name id) in messages
collect `(defconstant ,name ,id)
collect `(setf (gethash ,id *windows-message-lookup*)
(string ',name)))
(values)))
(defun get-message-text (id)
"Return the text associated with ID and T if it's found, or a string
saying it's not found and NIL if it's not found."
(multiple-value-bind (text foundp)
(gethash id *windows-message-lookup*)
(values (if foundp text (format nil (format nil "(WM_? ~a)" id)))
foundp)))
And now:
> (def-windows-messages
(WM_NULL 0)
(WM_CREATE 1))
> (get-message-text 0)
"WM_NULL"
t
> (get-message-text 1)
"WM_CREATE"
t
> (get-message-text -1)
"(WM_? -1)"
nil
> (get-message-text 99)
"(WM_? 99)"
nil
Note that as the code now is (it was previously slightly different) it would work to say
(defconstant some-id 12)
(define-windows-messages
(WM_FOO some-id))
As an example of the quoting problems which were part of the original macro, here is a macro called define-message-array which can be used to define arrays of messages in a similar way to the original macro. It differs from the original macro in that you can specify the name of the array.
(defmacro define-message-array (name &body from)
`(defparameter ,name
(make-array ,(length from)
:initial-contents
'(,@(loop for (n v) in from
collect (cons v (string n)))))))
Note that there is no nested backquoting here: you don't often need that.
With this, then
(define-message-array *foo*
(x 1)
(y 2))
expands to
(defparameter *foo*
(make-array 2 :initial-contents '((1 . "X") (2 . "Y"))))