Оценить аргументы, переданные макросу, который генерирует функции в lisp
Я пытаюсь создать макрос, который определяет функцию доступа для каждой конфигурации на основе объекта конфигурации, созданного py-configparser:
(defmacro make-config-accessor (config section option)
; create an upper case function name then intern
(let* ((fun-name (intern (string-upcase
(str:replace-all "_" "-"
(str:concat "get-" option))))))
`(defun ,fun-name (config)
(py-configparser:get-option config ,section ,option))))
Он отлично работает, если option передается как строка, но не когда это пара типа (car ("db" . "test.db")), форма передается как есть и вызывает ошибку.. Как оценить option аргумент внутри макроса, без использования eval.
Полный пример: предположим, у меня есть test.ini файл:
[Settings]
db = "test.db"
С помощью py-configparser (вы можете установить его с помощью (ql:quickload "py-configparser"), вы можете превратить файл конфигурации в объект Lisp:
(setf *test-config* (py-configparser:make-config))
(py-configparser:read-files *test-config* '("~/test.ini"))
Это должен быть результат:
#S(PY-CONFIGPARSER:CONFIG
:DEFAULTS #S(PY-CONFIGPARSER::SECTION :NAME "DEFAULT" :OPTIONS NIL)
:SECTIONS (#S(PY-CONFIGPARSER::SECTION
:NAME "Settings"
:OPTIONS (("db" . "\"test.db\""))))
:OPTION-NAME-TRANSFORM-FN #<FUNCTION STRING-DOWNCASE>
:SECTION-NAME-TRANSFORM-FN #<FUNCTION IDENTITY>)
("~/test.ini")
Затем вы можете получить db такой вариант:
(py-configparser:get-option *test-config* "Settings" "db")
Выход:
"\"test.db\""
Теперь я пишу макрос для создания функции для каждой опции, например db, нравиться (get-db *test-config*) должен дать мне такой же результат.
Я заставил это работать с make-config-accessor макрос выше, но затем, когда я передал форму вроде (car ("db" . "test.db")), Я должен использовать eval в противном случае str:concat терпит неудачу.
я сделал gen-accessors который перебирает все параметры в объекте конфигурации и генерирует для него аксессор:
(defun gen-accessors (config)
(let ((sections (py-configparser:sections config)))
(loop for s in sections
do (loop for i in (py-configparser:items config s)
do (let* ((o (car i)))
(make-config-accessor config s o))))))
3 ответа
Первое правило написания макросов: если вы обнаружите, что используете evalзначит, вы почти наверняка ошиблись. В этом случае вы сделали ошибку: вам вообще не нужен макрос: вам нужна функция.
В частности, вы, вероятно, захотите эту функцию или что-то в этом роде:
(defun make-config-accessor (section option)
;; Make an accessor for OPTION in SECTION with a suitable name
(let ((fun-name (intern (nsubstitute #\- #\_
(format nil "GET-~A"
(string-upcase option))))))
(setf (symbol-function fun-name)
(lambda (config)
(py-configparser:get-option config section option)))
fun-name)))
Затем дан подходящий читатель конфигурации
(defun read-config (&rest files)
(py-configparser:read-files (py-configparser:make-config)
files))
вместе с довольно упрощенной (менее одноразовыми привязками) версией вашего gen-accessors:
(defun gen-accessors (config)
(loop for s in (py-configparser:sections config)
appending (loop for i in (py-configparser:items config s)
collect (make-config-accessor s (car i)))))
Тогда, например, если /tmp/x.ini содержит
[Settings]
db = "test.db"
scrunge = 12
потом
> (gen-accessors (read-config "/tmp/x.ini"))
(get-scrunge get-db)
> (get-scrunge (read-config "/tmp/x.ini"))
"12"
Вы можете дать определение make-config-accessor возможно, даже лучше с чем-то вроде этого:
(defun curryr (f &rest trailing-args)
(lambda (&rest args)
(declare (dynamic-extent args))
(apply f (append args trailing-args))))
(defun make-config-accessor (section option)
;; Make an accessor for OPTION in SECTION with a suitable name
(let ((fun-name (intern (nsubstitute #\- #\_
(format nil "GET-~A"
(string-upcase option))))))
(setf (symbol-function fun-name)
(curryr #'py-configparser:get-option section option))
fun-name))
Конечно, не всем это понравится.
Это один из редких случаев, когда вам нужно использовать eval в сочетании с вызовом макроса в обратных кавычках с отменой кавычек для аргументов.
(Я однажды наткнулся на эту конструкцию и сам назвал ее eval-over-macro-call. - Следуя традиции именованияlet-over-lambda. - Вообще-то это надо называтьeval-over-backquoted-macro-call-with-unquoting. Это позволяет вам использовать макросы динамически. Сам Всеволод Дёмкин тоже споткнулся. Я ему ответил, потому что наткнулся на него примерно в то же время или раньше. Макросы, как вы уже поняли, не допускают произвольного контроля над оценкой.)
Но сначала я создал несколько вспомогательных функций.
(Вы можете использовать свой:strпакет функций, но у меня возникли проблемы с его установкой. Лучше меньше зависимостей. А я лично предпочел быcl-ppcre на замену и т.д. Однако в вашем случае можно избавиться от любых зависимостей.
internзагрязняет ваше пространство имен. Вы хотите, чтобы только пространство имен функции имелоget-записи имени функции. Но не пространство имен переменных. Поэтому, чтобы возвращать только символы без их автоматического интернирования, используйтеread-from-string.
В dotted-list-p функция требует :alexandriaпакет. Тем не менее, в любом случае он нужен в основном, и поскольку это один из наиболее часто используемых пакетов в общем lisp shpere (вместе с:cl-ppcre) Думаю, это не считается "дополнительной зависимостью".
Для dotted-pair-p функция, мне пришлось проделать несколько поисков.
В dotted-list-to-list функция конвертера, я сам написал.
Вы могли бы избавиться от всех dotted-list функций, если вы будете использовать простые списки строк для options.
В этом случае в макросе просто используйте listp вместо того dotted-list-p. И использоватьoption вместо того (dotted-list-to-list option).
;; one character replacement
(substitute #\+ #\Space "a simple example")
replacer find obj
(defun string-to-upper-symbol (str)
(read-from-string (substitute #\- #\_ (format nil "get-~A" str))))
(ql:quickload :alexandria)
(defun dotted-list-p (x)
(and (not (alexandria:proper-list-p x))
(consp x)))
;; correct - but gives nil if empty list (or (null x) ...) would include empty list
(defun dotted-or-empty-list-p (x)
(or (null x) (dotted-list-p x)))
;; this gives t for empty list and dotted lists
(defun dotted-pair-p (x)
(and (not (listp (cdr x))) (consp x)))
(defun dotted-list-to-list (dotted-list &optional (acc '()))
(cond ((null dotted-list) (nreverse acc))
((dotted-pair-p dotted-list) (dotted-list-to-list '() (cons (cdr dotted-list)
(cons (car dotted-list)
acc))))
(t (dotted-list-to-list (cdr dotted-list) (cons (car dotted-list) acc)))))
Ваш макрос содержится в списке аргументов config который, однако, никогда не используется.
Если вы просто забыли отменить цитирование config в макросе правильным решением будет:
(defmacro %make-config-accessor (config section option)
; create an upper case function name then intern
(let* ((fun-name (string-to-upper-symbol option)))
`(defun ,fun-name (,config)
(py-configparser:get-option ,config ,section ,option)))))
(defun make-config-accessor (config section option)
(if (dotted-list-p option)
(loop for x in (dotted-list-to-list option)
do (eval `(%make-config-accessor ,config ,section ,x)))
(%make-config-accessor config section option)))
;; call with
;; (make-config-accessor '<your-config> '<your-section> '("option1" "option2" . "option3"))
;; test for existence
;; #'get-option1
;; #'get-option2
;; #'get-option3
В другом случае, когда конфигурация вам не нужна, правильным решением будет:
(defmacro %make-config-accessor (section option)
; create an upper case function name then intern
(let* ((fun-name (string-to-upper-symbol option)))
`(defun ,fun-name (config)
(py-configparser:get-option config ,section ,option)))))
(defun make-config-accessor (section option)
(if (dotted-list-p option)
(loop for x in (dotted-list-to-list option)
do (eval `(%make-config-accessor ,section ,x)))
(%make-config-accessor section option)))
;; call with
;; (make-config-accessor '<your-section> '("option1" "option2" . "option3"))
;; test for existence
;; #'get-option1
;; #'get-option2
;; #'get-option3
Обратите внимание: поскольку вам нужна функция, вы должны указать в вызове аргументы config а также section (они ждут оценки, пока находятся в функции - вокруг option оценивается.
Благодаря quote а также backquote а также unquote а также eval у вас есть полный контроль над уровнями оценки в lisp.
Иногда нужно использовать больше quotes в списке аргументов, если нужно иметь контроль над несколькими раундами оценок.
Вы также можете объединить вспомогательный макрос и функцию в один макрос. Однако тогда каждый раз, когда вы вызываете макрос, вы должны использовать этоeval-over-backquoted-macro-call не цитируя нужный аргумент.
(defmacro make-config-accessor (section option)
(if (dotted-list-p option)
(loop for x in (dotted-list-to-list option)
do (eval `(make-config-accessor ,section ,x)))
`(defun ,(string-to-upper-symbol c) (config)
(py-configparser:get-option config ,section ,option))))
;; call it with
;; (eval `(make-config-accessor <your-section> ,<your-option>))
;; e.g.
;; (eval `(make-config-accessor <your-section> ,'("opt1" "opt2" . "opt3")))
;; test existence with
;; #'get-opt1
;; #'get-opt2
;; #'get-opt3
Кстати. Я больше не покупаю это "eval запрещено "говорить. В таких случаях - в основном контроль оценки в макросах, нужно eval как единственная альтернатива написанию дополнительного мини-интерпретатора для этой проблемы... что было бы гораздо утомительнее (и, скорее всего, также более подвержено ошибкам).
Вы не дали работоспособного кода. Я написал, что мне пришлось разобраться во всем этом с помощью некоторых функций / макросов tody.
(defmacro q (b c)
`(defun ,(string-to-upper-symbol c) (a) (list a ,b ,c)))
(defun q-fun (b c)
(if (dotted-list-p c)
(loop for x in (dotted-list-to-list c)
do (eval `(q ,b ,x)))
(q b c)))
;; (q "b" "c")
;; (q "b" '("d" . "e"))
;; (macroexpand-1 '(q "b" '("d" . "e")))
(defmacro p (b c)
(if (dotted-list-p c)
(loop for x in (dotted-list-to-list c)
do (eval `(p ,b ,x)))
`(defun ,(string-to-upper-symbol c) (a) (list a ,b ,c))))
Вам нужно два уровня оценки.
Пытаться:
(defmacro make-config-accessor (config section option)
; create an upper case function name then intern
`(let* ((fun-name (intern (string-upcase
(str:replace-all "_" "-" (str:concat "get-" ,option))))))
(eval `(defun ,fun-name (config)
(py-configparser:get-option config ,,section ,,option)))))
Сейчас же option оценивается в let*форма. И вернулсяdefun Затем необходимо оценить форму (которая всегда находится в глобальной области, в нулевой лексической среде или на верхнем уровне), используя eval.
Это все изменения, которые потребовались мне для правильного запуска вашего кода. Для справки я добавляю весь код, который я запускал здесь (примечание: есть изменение вgen-accessors, Я думаю, вы хотели использовать config и нет *config*).
(ql:quickload "str")
(ql:quickload "py-configparser")
(defmacro make-config-accessor (config section option)
; create an upper case function name then intern
`(let* ((fun-name (intern (string-upcase
(str:replace-all "_" "-"
(str:concat "get-" ,option))))))
(eval `(defun ,fun-name (config)
(py-configparser:get-option config ,,section ,,option)))))
(defun gen-accessors (config)
(let ((sections (py-configparser:sections config)))
(loop for s in sections
do (loop for i in (py-configparser:items config s)
do (let* ((o (car i)))
(make-config-accessor config s o))))))
(setf *test-config* (py-configparser:make-config))
(py-configparser:read-files *test-config* '("~/Desktop/test.ini"))
(gen-accessors *test-config*)
(get-db *test-config*)