Некоторое расширение этой идеи, вызвано тем, что часто приходится сталкиваться с вот таким кодом:
(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
;;
(that) - достаёт из окружения значение имени it
(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))Ах да - хэш-таблица была бы лучше списка :) Ну и gensym для её имени.
> Ах да - хэш-таблица была бы лучше списка :) Ну и gensym для её имени.
Ещё лучше было бы (в плане производительности) каждой переменной окружения ставить в соответствие свой gensym, и все эти связи разруливать во время раскрытия макроса. Правда, без кодобродства в этом случае, похоже, не обойтись...
Я хотел сделать
что-то такое (код - лажа, давно писал), но мне начало казаться, что наличие чужеродных объектов внутри кондишена - это как-то нехорошо. Вот почему-то когда пишу так, чувствую что делаю что-то плохое :)
Не уверен что хэш-таблица лучше - не та задача(в смысле есть ещё декларативный аспект).
а gensym надо бы
А вообще, думаю, нужная вещь. Респект!
Тогда вот:
(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))))И в (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))))Соответственно PUTHASH и GETHASH, но тут ещё MAKE-HASH-TABLE вначале.
Кстати, если сделать :test #'equal, то "переменными" могут быть сложные объекты - списки, массивы и т.п:
(aif (it (summa 1 2 3) (+ 1 2 3))
(that (summa 1 2 3)))Правда непонятно - зачем это может быть нужно ;)
Ну вот мне тоже так казалось - отдельный макрос для if, для when и т.д. Тогда как речь идёт об общей идеи:
некое-общее-окружение
<< положили
<< вытащили
;; и т.д.
А 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)))Тогда в результирующем коде не будет составного объекта для (искусственного) окружения в который что-то кладётся/вытаскивается в run-time, все подстановки будут делаться на стадии macroexpansion.
Ну дык тривиального обхода в глубину в данном случае же достаточно для генерации произвольного let-over-something для 99% ситуаций - да, ведь и правда может попасться внутри конструкция, в которой (:var _ ...) или (it _ ...) будет предназначаться для других вещей, но это большая редкость.
Но меня смущает присутствие биндингов внутри condition - почему-то кажется как-то легасиевато. Вот если бы мини-еdsl с каким-нибудь красивым и простым для восприятия биндингов синтаксисом.
Например, из последнего листинга в ссылаемом посте я бы предпочел писать второй вариант - длиннее ненамного, зато гораздо читабельнее, и, в некоторой степени, красивее - это как книжки вперемешку на столе, и книжки упорядоченно на полке. Субъективно, конечно, но вот такие ассоциации.
Т.е. тебе вообще анафорические макросы кажутся странными и ты бы предпочёл писать не
(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))а просто
(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)))Просто я тоже пока не вижу дикой распространённости анафорических макросов, единственное с чем не поспорить это с тем, что они сокращают код, но может запутывают?
Нужен 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)))Т.е. сбилась хронология параметров, а чтобы за ней следить нужен целый интерпретатор ;) что естественно - это ж фактически язык с возможностью вводить переменные по месту.
А, там ещё ошибки, но это легко исправимо.
(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))))работает:
(macroexpand
'(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)))Ну и полный провал:
(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)))так что первый run-time вариант и только.
Да нет, наоборот - я крайне положительно отношусь к анафорическим макросам и подходу macrolet-over-expansion, а здесь мне не нравится именно присутствие в предикате метаданных - мне кажется, они захламляют логику. То есть, в приведённом тобой коде для меня первый aif - хорошо, а второй - плохо, и я действительно предпочёл бы переписать его с явным let.
Кстати, with-environment - полезный трюк, а я дурак с augment-environment парился :)
Кстати, в случае с кодоволкером следить за хронологией не приходится. Даже в том моём недоволкере таких проблем не возникает, потому что встречая биндинг, он заменяется на переменную биндинга. А биндинги можно просто собирать и реверсить, вставляя в let*.
Тут действительно, как контраргумент удобству, имеет место нестандартный процесс описания вычислений.
Предлагаю вместо того чтобы терпеть малое ради большего, воспользоваться подходом Ander'a Skirnir'a,
а именно, чтобы можно было писать так:
(aif (+ 1 2 3 (:it (* 1 2 3)) (:it foo (/ 1 2 3)))
(format t "~A, ~A ~%" (:that) (:that foo)))Если уж пользоваться нестандартной семантикой - то делать это явно.
ну и переменной 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
Не увидел разницы (кроме двоеточия перед именем ;))
Я говорил про семантику с таким определением:
Анафорический макрос это
1) Макрос в котором вводится общее окружение как хэш-таблица
(хэш-таблица как alisp, plist или как hash-table - это детали
реализации),
2) Вводится функция/макрос для размещения пары (объект . ассоциация) в
этом окружении,
3) И функция/макрос для получения ассоциации по объекту из окружения.
(то что происходит при конфликтах ассоциаций - тоже деталь реализации)
Обычные анафорические макросы это частный (вырожденный, когда анаф.
окружение - всего одна переменная it) случай и они хороши именно тем,
что просты и абсолютно предсказуемы. Но они, в то же время, -
статические конструкции. А вот описанные выше макросы - динамические, но
также имеют простую концепцию и полностью предсказуемы.
Все остальные способы реализации подобного (как я пробовал выше) -
совершенно ненадёжны с точки зрения хронологии.
Что касается того, что все обращения к общему окружению происходят в
run-time (it и that не пропадают на стадии анализа, а оставляют следы в
скомпилированном коде) то это очень хорошо, т.к. решает проблемы с
хронологией (никакой примитивный code-walker не способен установить
порядок раскрытия, скажем, пользовательского макроса - он может
привязать it формы в let, но если у них есть побочные эффекты, то их
последовательность легко спутается).
Вот, и реализация очень проста - если нужно, можно юзать ;) Ещё
напрашивается такой же макрос, но не с ассоциативной памятью, а со
стеком, т.к. тут есть некая аналогия с организацией памяти в программах -
EBP как аналог (ассоциативного) локального окружения и ESP как аналог
текущего стека (функции).
Да, действительно, привязывать it-формы в let, так чтобы было 100% корректно - нетривиальная и не нужная задача.
А зачем нужна форма (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))))))(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)))))Будет style-warning о том, что body не используется, поэтому нужно заигнорить аргументы. &whole используется чтобы не возиться с парсингом lambda-list - а то для &optional arg нужно ,arg а для &body arg - ,@arg.
Итого -
http://lisper.ru/apps/format/149 - 70 строк ;)