Анафорические макросы
Некоторое расширение этой идеи, вызвано тем, что часто приходится сталкиваться с вот таким кодом:
(обычные aif так не могут). Поэтому - вот полный анафорический паттерн который служит для того чтобы запоминать произвольные формы в коде в произвольных количествах под произвольными именами:
;;; утилиты
;; может лучше fand (functional and)?
(defun compose (f1 f2)
(lambda (x) (funcall f1 (funcall f2 x))))
(defun filter (predicate list)
(mapcan (lambda (e) (and (funcall predicate e) (list e)))
list))
(defun is-&symbol-p (sym)
(string= (subseq (string sym) 0 1) "&"))
;;; собственно макросы
(defmacro with-it-environment (&body body)
`(let (-environment-)
(macrolet ((it (name &optional value)
(if value
`(progn
(push `(,',name . ,,value) -environment-)
,value)
`(progn
(push `(it . ,,name) -environment-)
,name)))
(that (&optional name)
(if name
`(cdr (assoc ',name -environment-))
`(cdr (assoc 'it -environment-)))))
,@body)))
(defmacro define-simple-anaphoric-macro (definition original)
`(defmacro ,(car definition) (&whole whole ,@(cdr definition))
(declare (ignore ,@(filter (compose 'not 'is-&symbol-p) (cdr definition))))
`(with-it-environment
(,',original ,@(cdr whole)))))
(define-simple-anaphoric-macro (abody &body body) progn)
(define-simple-anaphoric-macro (aif test then &optional else) if)
(define-simple-anaphoric-macro (awhen test &body body) when)
(define-simple-anaphoric-macro (aunless test &body body) unless)
;;; etc.
И теперь:
;; (it value) - размещает value в окружение под именем it
;; (it name value) - размещает value в окружение под именем name
;; (that) - достаёт из окружения значение имени it
;; (that name) - достаёт из окружения значение имени name
(aif (it 5)
(that))
(aif (+ 1 2 3 (it (* 1 2 3)) (it foo (/ 1 2 3)))
(format t "~A, ~A ~%" (get-it) (get-it foo)))
(abody
(print (+ (it var (* 1 2 3)) 2 3))
(print (that var)))
Либо как-нибудь (гипотетически) так:
(if (... (значение-которое-нужно-запомнить) ...)
...)
...)
(обычные aif так не могут). Поэтому - вот полный анафорический паттерн который служит для того чтобы запоминать произвольные формы в коде в произвольных количествах под произвольными именами:
;;; утилиты
;; может лучше fand (functional and)?
(defun compose (f1 f2)
(lambda (x) (funcall f1 (funcall f2 x))))
(defun filter (predicate list)
(mapcan (lambda (e) (and (funcall predicate e) (list e)))
list))
(defun is-&symbol-p (sym)
(string= (subseq (string sym) 0 1) "&"))
;;; собственно макросы
(defmacro with-it-environment (&body body)
`(let (-environment-)
(macrolet ((it (name &optional value)
(if value
`(progn
(push `(,',name . ,,value) -environment-)
,value)
`(progn
(push `(it . ,,name) -environment-)
,name)))
(that (&optional name)
(if name
`(cdr (assoc ',name -environment-))
`(cdr (assoc 'it -environment-)))))
,@body)))
(defmacro define-simple-anaphoric-macro (definition original)
`(defmacro ,(car definition) (&whole whole ,@(cdr definition))
(declare (ignore ,@(filter (compose 'not 'is-&symbol-p) (cdr definition))))
`(with-it-environment
(,',original ,@(cdr whole)))))
(define-simple-anaphoric-macro (abody &body body) progn)
(define-simple-anaphoric-macro (aif test then &optional else) if)
(define-simple-anaphoric-macro (awhen test &body body) when)
(define-simple-anaphoric-macro (aunless test &body body) unless)
;;; etc.
И теперь:
;; (it value) - размещает value в окружение под именем it
;; (it name value) - размещает value в окружение под именем name
;; (that) - достаёт из окружения значение имени it
;; (that name) - достаёт из окружения значение имени name
(aif (it 5)
(that))
(aif (+ 1 2 3 (it (* 1 2 3)) (it foo (/ 1 2 3)))
(format t "~A, ~A ~%" (get-it) (get-it foo)))
(abody
(print (+ (it var (* 1 2 3)) 2 3))
(print (that var)))
Либо как-нибудь (гипотетически) так:
(awhen (ok? (it (make-thing :depend-on (it another-thing (make-thing)))))
(it result (bang! (that) (that another-thing)))
(print (that result))
(handle result))
(it result (bang! (that) (that another-thing)))
(print (that result))
(handle result))
[#] Ответ на комментарий от treep 22.07.2010 15:19
> Ах да - хэш-таблица была бы лучше списка :) Ну и gensym для её имени.
Ещё лучше было бы (в плане производительности) каждой переменной окружения ставить в соответствие свой gensym, и все эти связи разруливать во время раскрытия макроса. Правда, без кодобродства в этом случае, похоже, не обойтись...
Ещё лучше было бы (в плане производительности) каждой переменной окружения ставить в соответствие свой gensym, и все эти связи разруливать во время раскрытия макроса. Правда, без кодобродства в этом случае, похоже, не обойтись...
[#]
Я хотел сделать что-то такое (код - лажа, давно писал), но мне начало казаться, что наличие чужеродных объектов внутри кондишена - это как-то нехорошо. Вот почему-то когда пишу так, чувствую что делаю что-то плохое :)
[#] Ответ на комментарий от treep 22.07.2010 15:19
Не уверен что хэш-таблица лучше - не та задача(в смысле есть ещё декларативный аспект).
а gensym надо бы
А вообще, думаю, нужная вещь. Респект!
а gensym надо бы
А вообще, думаю, нужная вещь. Респект!
[#]
Тогда вот:
И в (disassemble #'(lambda () (aif (it var 5) (that var)))) мы увидим только вызовы ALLOCATE-CONS-TO-ECX для размещения в окружении и %ASSOC-EQ для доступа к нему, это O(1) + O(N) как я понимаю.
А вот хэш-таблицы могут быть немного эффективнее
Соответственно PUTHASH и GETHASH, но тут ещё MAKE-HASH-TABLE вначале.
(defmacro with-it-environment (&body body)
(let ((env (gensym "ENVIRONMENT")))
`(let (,env)
(macrolet ((it (name &optional value)
(if value
`(progn
(push (cons ',name ,value) ,',env)
,value)
`(progn
(push (cons 'it ,name) ,',env)
,name)))
(that (&optional name)
(if name
`(cdr (assoc ',name ,',env))
`(cdr (assoc 'it ,',env)))))
,@body))))
(let ((env (gensym "ENVIRONMENT")))
`(let (,env)
(macrolet ((it (name &optional value)
(if value
`(progn
(push (cons ',name ,value) ,',env)
,value)
`(progn
(push (cons 'it ,name) ,',env)
,name)))
(that (&optional name)
(if name
`(cdr (assoc ',name ,',env))
`(cdr (assoc 'it ,',env)))))
,@body))))
И в (disassemble #'(lambda () (aif (it var 5) (that var)))) мы увидим только вызовы ALLOCATE-CONS-TO-ECX для размещения в окружении и %ASSOC-EQ для доступа к нему, это O(1) + O(N) как я понимаю.
А вот хэш-таблицы могут быть немного эффективнее
(defmacro with-it-environment (&body body)
(let ((env (gensym "ENVIRONMENT")))
`(let ((,env (make-hash-table :test 'eq)))
(macrolet ((it (name &optional value)
(if value
`(progn
(setf (gethash ',name ,',env) ,value)
,value)
`(progn
(setf (gethash 'it ,',env) ,name)
,name)))
(that (&optional name)
(if name
`(gethash ',name ,',env)
`(gethash 'it ,',env))))
,@body))))
(let ((env (gensym "ENVIRONMENT")))
`(let ((,env (make-hash-table :test 'eq)))
(macrolet ((it (name &optional value)
(if value
`(progn
(setf (gethash ',name ,',env) ,value)
,value)
`(progn
(setf (gethash 'it ,',env) ,name)
,name)))
(that (&optional name)
(if name
`(gethash ',name ,',env)
`(gethash 'it ,',env))))
,@body))))
Соответственно PUTHASH и GETHASH, но тут ещё MAKE-HASH-TABLE вначале.
[#] Ответ на комментарий от treep 23.07.2010 12:50
Кстати, если сделать :test #'equal, то "переменными" могут быть сложные объекты - списки, массивы и т.п:
Правда непонятно - зачем это может быть нужно ;)
(aif (it (summa 1 2 3) (+ 1 2 3))
(that (summa 1 2 3)))
(that (summa 1 2 3)))
Правда непонятно - зачем это может быть нужно ;)
[#] Ответ на комментарий от Ander Skirnir 23.07.2010 06:40
Ну вот мне тоже так казалось - отдельный макрос для if, для when и т.д. Тогда как речь идёт об общей идеи:
А aif и прочие это просто сокращения для
Вобщем суть в том, что если нам что-то нужно в куске кода - мы обворачиваем его в let и помечаем нужные части именами, а тут мы этого не делаем, а динамически создаём имена в it-ах которые помещаются в общий env в let. Можно конечно пойти дальше - сделать code-walker и генерировать общий let в котором будет по имени для каждой введённой переменной:
Тогда в результирующем коде не будет составного объекта для (искусственного) окружения в который что-то кладётся/вытаскивается в run-time, все подстановки будут делаться на стадии macroexpansion.
некое-общее-окружение
<< положили
<< вытащили
;; и т.д.
А aif и прочие это просто сокращения для
с-неким-общим-окружением
if
...
с-неким-общим-окружением
when
...
и т.п.
Вобщем суть в том, что если нам что-то нужно в куске кода - мы обворачиваем его в let и помечаем нужные части именами, а тут мы этого не делаем, а динамически создаём имена в it-ах которые помещаются в общий env в let. Можно конечно пойти дальше - сделать code-walker и генерировать общий let в котором будет по имени для каждой введённой переменной:
(aif (it something (something (it my-var (value))))
(format t "ok: ~A, ~A~%" something my-var)
(format t "no: ~A, ~A~%" something my-var))
=>
(let* ((my-var (value))
(something (something my-var)))
(if something
(format t "ok: ~A, ~A~%" something my-var)
(format t "no: ~A, ~A~%" something my-var)))
(format t "ok: ~A, ~A~%" something my-var)
(format t "no: ~A, ~A~%" something my-var))
=>
(let* ((my-var (value))
(something (something my-var)))
(if something
(format t "ok: ~A, ~A~%" something my-var)
(format t "no: ~A, ~A~%" something my-var)))
Тогда в результирующем коде не будет составного объекта для (искусственного) окружения в который что-то кладётся/вытаскивается в run-time, все подстановки будут делаться на стадии macroexpansion.
[#] Ответ на комментарий от treep 23.07.2010 13:10
Ну дык тривиального обхода в глубину в данном случае же достаточно для генерации произвольного let-over-something для 99% ситуаций - да, ведь и правда может попасться внутри конструкция, в которой (:var _ ...) или (it _ ...) будет предназначаться для других вещей, но это большая редкость.
Но меня смущает присутствие биндингов внутри condition - почему-то кажется как-то легасиевато. Вот если бы мини-еdsl с каким-нибудь красивым и простым для восприятия биндингов синтаксисом.
Но меня смущает присутствие биндингов внутри condition - почему-то кажется как-то легасиевато. Вот если бы мини-еdsl с каким-нибудь красивым и простым для восприятия биндингов синтаксисом.
[#] Ответ на комментарий от treep 23.07.2010 13:10
Например, из последнего листинга в ссылаемом посте я бы предпочел писать второй вариант - длиннее ненамного, зато гораздо читабельнее, и, в некоторой степени, красивее - это как книжки вперемешку на столе, и книжки упорядоченно на полке. Субъективно, конечно, но вот такие ассоциации.
[#] Ответ на комментарий от Ander Skirnir 23.07.2010 14:30
Т.е. тебе вообще анафорические макросы кажутся странными и ты бы предпочёл писать не
а просто
Просто я тоже пока не вижу дикой распространённости анафорических макросов, единственное с чем не поспорить это с тем, что они сокращают код, но может запутывают?
(aif (request-to-db request)
(format t "We get ~A for request ~A~%" it request)
(format t "We get nothing for request ~A~%" request))
;; ну или
(aif (some-work (it result (request-to-db request)))
(format t "We get ~A for request ~A~%" result request)
(format t "We get nothing for request ~A~%" request))
(format t "We get ~A for request ~A~%" it request)
(format t "We get nothing for request ~A~%" request))
;; ну или
(aif (some-work (it result (request-to-db request)))
(format t "We get ~A for request ~A~%" result request)
(format t "We get nothing for request ~A~%" request))
а просто
(let ((result (request-to-db request)))
(some-work result)
(if result
(format t "We get ~A for request ~A~%" result request)
(format t "We get nothing for request ~A~%" request)))
(some-work result)
(if result
(format t "We get ~A for request ~A~%" result request)
(format t "We get nothing for request ~A~%" request)))
Просто я тоже пока не вижу дикой распространённости анафорических макросов, единственное с чем не поспорить это с тем, что они сокращают код, но может запутывают?
[#] Ответ на комментарий от Ander Skirnir 23.07.2010 14:25
Нужен code-walker, а нормального переносимого решения (чтобы учитывал семантику) я пока не видел.
Попробовал сделать на макросах, не считая одной помарки и зависимости на sb-cltl2:macroexpand-all - получилось, но в итоге параметры в let* перепутываются местами :) Например:
(defmacro with-environment (env &body body &environment environment)
`(let ((,env ,environment))
,@body))
;; KLUDGE: can't see local variables in macrolet's macros
(defvar *environment* nil)
(defmacro with-it-environment (&body body)
(setf *environment* nil)
(macrolet ((it (name &optional value)
(if value
(progn
(push `(,name . ,value) *environment*)
value)
(progn
(push `(it . ,name) *environment*)
name))))
(let ((expanded-body
(with-environment env
(sb-cltl2:macroexpand-all `(progn ,@body) env))))
`(let* ,(mapcar #'(lambda (e)
`(,(car e) ,(cdr e)))
*environment*)
,expanded-body))))
(macroexpand
'(with-it-environment
(when (ok? (it (make-thing :depend-on (it another-thing (make-thing)))))
(it result (bang! it another-thing))
(print result)
(handle result))))
=>
(LET ((RESULT (BANG! IT ANOTHER-THING))
(ANOTHER-THING (MAKE-THING))
(IT (MAKE-THING :DEPEND-ON (IT ANOTHER-THING (MAKE-THING)))))
(PROGN
(IF (OK? (MAKE-THING :DEPEND-ON (MAKE-THING)))
(PROGN (BANG! IT ANOTHER-THING) (PRINT RESULT) (HANDLE RESULT))
NIL)))
Т.е. сбилась хронология параметров, а чтобы за ней следить нужен целый интерпретатор ;) что естественно - это ж фактически язык с возможностью вводить переменные по месту.
Попробовал сделать на макросах, не считая одной помарки и зависимости на sb-cltl2:macroexpand-all - получилось, но в итоге параметры в let* перепутываются местами :) Например:
(defmacro with-environment (env &body body &environment environment)
`(let ((,env ,environment))
,@body))
;; KLUDGE: can't see local variables in macrolet's macros
(defvar *environment* nil)
(defmacro with-it-environment (&body body)
(setf *environment* nil)
(macrolet ((it (name &optional value)
(if value
(progn
(push `(,name . ,value) *environment*)
value)
(progn
(push `(it . ,name) *environment*)
name))))
(let ((expanded-body
(with-environment env
(sb-cltl2:macroexpand-all `(progn ,@body) env))))
`(let* ,(mapcar #'(lambda (e)
`(,(car e) ,(cdr e)))
*environment*)
,expanded-body))))
(macroexpand
'(with-it-environment
(when (ok? (it (make-thing :depend-on (it another-thing (make-thing)))))
(it result (bang! it another-thing))
(print result)
(handle result))))
=>
(LET ((RESULT (BANG! IT ANOTHER-THING))
(ANOTHER-THING (MAKE-THING))
(IT (MAKE-THING :DEPEND-ON (IT ANOTHER-THING (MAKE-THING)))))
(PROGN
(IF (OK? (MAKE-THING :DEPEND-ON (MAKE-THING)))
(PROGN (BANG! IT ANOTHER-THING) (PRINT RESULT) (HANDLE RESULT))
NIL)))
Т.е. сбилась хронология параметров, а чтобы за ней следить нужен целый интерпретатор ;) что естественно - это ж фактически язык с возможностью вводить переменные по месту.
[#] Ответ на комментарий от treep 23.07.2010 15:34
(defmacro with-it-environment (&body body)
(setf *environment* nil)
(macrolet ((it (name &optional value)
(if value
(progn
(push `(,name . ,value) *environment*)
name)
(progn
(push `(it . ,name) *environment*)
'it))))
(let ((expanded-body
(with-environment env
(sb-cltl2:macroexpand-all `(progn ,@body) env))))
`(let* ,(nreverse
(mapcar #'(lambda (e)
`(,(car e) ,(cdr e)))
*environment*))
,expanded-body))))
(setf *environment* nil)
(macrolet ((it (name &optional value)
(if value
(progn
(push `(,name . ,value) *environment*)
name)
(progn
(push `(it . ,name) *environment*)
'it))))
(let ((expanded-body
(with-environment env
(sb-cltl2:macroexpand-all `(progn ,@body) env))))
`(let* ,(nreverse
(mapcar #'(lambda (e)
`(,(car e) ,(cdr e)))
*environment*))
,expanded-body))))
работает:
(macroexpand
'(with-it-environment
(it 1)
(it a 2)
(it b 3)
(list it a b)))
'(with-it-environment
(it 1)
(it a 2)
(it b 3)
(list it a b)))
вложенные it не работают:
(macroexpand
'(with-it-environment
(it (+ 1 2 3 (it a (* 1 2 3))))
(it b 4)
(it c 5)
(/ it a b c)))
'(with-it-environment
(it (+ 1 2 3 (it a (* 1 2 3))))
(it b 4)
(it c 5)
(/ it a b c)))
Ну и полный провал:
(macroexpand
'(with-it-environment
(if (it (panic? foo))
(it foo (reboot! it))
(it baz (burn-all! it)))))
=>
(LET* ((IT (PANIC? FOO)) (FOO (REBOOT! IT)) (BAZ (BURN-ALL! IT)))
(PROGN
(IF IT
FOO
BAZ)))
'(with-it-environment
(if (it (panic? foo))
(it foo (reboot! it))
(it baz (burn-all! it)))))
=>
(LET* ((IT (PANIC? FOO)) (FOO (REBOOT! IT)) (BAZ (BURN-ALL! IT)))
(PROGN
(IF IT
FOO
BAZ)))
так что первый run-time вариант и только.
[#] Ответ на комментарий от treep 23.07.2010 15:18
Да нет, наоборот - я крайне положительно отношусь к анафорическим макросам и подходу macrolet-over-expansion, а здесь мне не нравится именно присутствие в предикате метаданных - мне кажется, они захламляют логику. То есть, в приведённом тобой коде для меня первый aif - хорошо, а второй - плохо, и я действительно предпочёл бы переписать его с явным let.
Кстати, with-environment - полезный трюк, а я дурак с augment-environment парился :)
Кстати, with-environment - полезный трюк, а я дурак с augment-environment парился :)
[#] Ответ на комментарий от treep 23.07.2010 15:34
Кстати, в случае с кодоволкером следить за хронологией не приходится. Даже в том моём недоволкере таких проблем не возникает, потому что встречая биндинг, он заменяется на переменную биндинга. А биндинги можно просто собирать и реверсить, вставляя в let*.
[#] Ответ на комментарий от treep 23.07.2010 15:49
Тут действительно, как контраргумент удобству, имеет место нестандартный процесс описания вычислений.
Предлагаю вместо того чтобы терпеть малое ради большего, воспользоваться подходом Ander'a Skirnir'a,
а именно, чтобы можно было писать так:
(aif (+ 1 2 3 (:it (* 1 2 3)) (:it foo (/ 1 2 3)))
(format t "~A, ~A ~%" (:that) (:that foo)))
Если уж пользоваться нестандартной семантикой - то делать это явно.
Предлагаю вместо того чтобы терпеть малое ради большего, воспользоваться подходом Ander'a Skirnir'a,
а именно, чтобы можно было писать так:
(aif (+ 1 2 3 (:it (* 1 2 3)) (:it foo (/ 1 2 3)))
(format t "~A, ~A ~%" (:that) (:that foo)))
Если уж пользоваться нестандартной семантикой - то делать это явно.
[#] Ответ на комментарий от treep 23.07.2010 15:49
ну и переменной it пользоваться как результатом вычислений первой формы, т.е.:
(aif (+ 1 2 3 (:it (* 1 2 3)) (:it foo (/ 1 2 3)))
(format t "it = ~A. ~A, ~A ~%" it (:that) (:that foo)))
Получиться + обратная совместимость с aif, awhen ... из anaphora
(aif (+ 1 2 3 (:it (* 1 2 3)) (:it foo (/ 1 2 3)))
(format t "it = ~A. ~A, ~A ~%" it (:that) (:that foo)))
Получиться + обратная совместимость с aif, awhen ... из anaphora
[#] Ответ на комментарий от LinkFly 24.07.2010 19:55
Не увидел разницы (кроме двоеточия перед именем ;))
Я говорил про семантику с таким определением:
Анафорический макрос это
1) Макрос в котором вводится общее окружение как хэш-таблица (хэш-таблица как alisp, plist или как hash-table - это детали реализации),
2) Вводится функция/макрос для размещения пары (объект . ассоциация) в этом окружении,
3) И функция/макрос для получения ассоциации по объекту из окружения.
(то что происходит при конфликтах ассоциаций - тоже деталь реализации)
Обычные анафорические макросы это частный (вырожденный, когда анаф. окружение - всего одна переменная it) случай и они хороши именно тем, что просты и абсолютно предсказуемы. Но они, в то же время, - статические конструкции. А вот описанные выше макросы - динамические, но также имеют простую концепцию и полностью предсказуемы.
Все остальные способы реализации подобного (как я пробовал выше) - совершенно ненадёжны с точки зрения хронологии.
Что касается того, что все обращения к общему окружению происходят в run-time (it и that не пропадают на стадии анализа, а оставляют следы в скомпилированном коде) то это очень хорошо, т.к. решает проблемы с хронологией (никакой примитивный code-walker не способен установить порядок раскрытия, скажем, пользовательского макроса - он может привязать it формы в let, но если у них есть побочные эффекты, то их последовательность легко спутается).
Вот, и реализация очень проста - если нужно, можно юзать ;) Ещё напрашивается такой же макрос, но не с ассоциативной памятью, а со стеком, т.к. тут есть некая аналогия с организацией памяти в программах - EBP как аналог (ассоциативного) локального окружения и ESP как аналог текущего стека (функции).
Я говорил про семантику с таким определением:
Анафорический макрос это
1) Макрос в котором вводится общее окружение как хэш-таблица (хэш-таблица как alisp, plist или как hash-table - это детали реализации),
2) Вводится функция/макрос для размещения пары (объект . ассоциация) в этом окружении,
3) И функция/макрос для получения ассоциации по объекту из окружения.
(то что происходит при конфликтах ассоциаций - тоже деталь реализации)
Обычные анафорические макросы это частный (вырожденный, когда анаф. окружение - всего одна переменная it) случай и они хороши именно тем, что просты и абсолютно предсказуемы. Но они, в то же время, - статические конструкции. А вот описанные выше макросы - динамические, но также имеют простую концепцию и полностью предсказуемы.
Все остальные способы реализации подобного (как я пробовал выше) - совершенно ненадёжны с точки зрения хронологии.
Что касается того, что все обращения к общему окружению происходят в run-time (it и that не пропадают на стадии анализа, а оставляют следы в скомпилированном коде) то это очень хорошо, т.к. решает проблемы с хронологией (никакой примитивный code-walker не способен установить порядок раскрытия, скажем, пользовательского макроса - он может привязать it формы в let, но если у них есть побочные эффекты, то их последовательность легко спутается).
Вот, и реализация очень проста - если нужно, можно юзать ;) Ещё напрашивается такой же макрос, но не с ассоциативной памятью, а со стеком, т.к. тут есть некая аналогия с организацией памяти в программах - EBP как аналог (ассоциативного) локального окружения и ESP как аналог текущего стека (функции).
[#] Ответ на комментарий от treep 24.07.2010 23:53
Да, действительно, привязывать it-формы в let, так чтобы было 100% корректно - нетривиальная и не нужная задача.
А зачем нужна форма (declare (ignore ,@(filter (compose 'not 'is-&symbol-p) (cdr definition)))) ?
У без неё всё отлично работает...
И всё же неплохо было бы сохранить обратную совместимость с существующими анафорическими макросами,
например так:
А зачем нужна форма (declare (ignore ,@(filter (compose 'not 'is-&symbol-p) (cdr definition)))) ?
У без неё всё отлично работает...
И всё же неплохо было бы сохранить обратную совместимость с существующими анафорическими макросами,
например так:
(defmacro define-simple-anaphoric-macro-compatible (definition original)
`(defmacro ,(car definition) (&whole whole ,@(cdr definition))
`(with-it-environment
(let (it)
(,',original (setq it ,(cadr whole)) ,@(cddr whole))))))
`(defmacro ,(car definition) (&whole whole ,@(cdr definition))
`(with-it-environment
(let (it)
(,',original (setq it ,(cadr whole)) ,@(cddr whole))))))
[#] Ответ на комментарий от LinkFly 25.07.2010 19:53
(macroexpand-1 '(define-simple-anaphoric-macro-compatible (abody2 &body body) progn))
(DEFMACRO ABODY2 (&WHOLE WHOLE &BODY BODY)
`(WITH-IT-ENVIRONMENT
(LET (IT)
(PROGN (SETQ IT ,(CADR WHOLE)) ,@(CDDR WHOLE)))))
(DEFMACRO ABODY2 (&WHOLE WHOLE &BODY BODY)
`(WITH-IT-ENVIRONMENT
(LET (IT)
(PROGN (SETQ IT ,(CADR WHOLE)) ,@(CDDR WHOLE)))))
Будет style-warning о том, что body не используется, поэтому нужно заигнорить аргументы. &whole используется чтобы не возиться с парсингом lambda-list - а то для &optional arg нужно ,arg а для &body arg - ,@arg.
Итого - http://lisper.ru/apps/format/149 - 70 строк ;)