Рекурсивные макросы в Common Lisp

(defun fact (x)
(if (< x 2) 1
(* x (fact (1- x)))))

(defmacro mfact (x)
`(fact ,x))

Или напиши что тебе действительно надо, или используй #. и не парь мозги

А совсем без функции, чисто на макросах никак нельзя?

> Или напиши что тебе действительно надо,

Рекурсивный макрос.

> или используй #.

Что это?

mozhno, no zachem?

use incremental programming!

kompilyator vyzovet (fact x) i podstavit tam gde ty vyzval (mfact x)

(defmacro mrfact (x) `(if (< ,x 2) 1 (* ,x (mrfact (1- ,x)))))

Это "подставит" цепочку вложенных if-ов с умножением, а никак не конкретное значение

Da verno, pervyj macros pravil'nyj.

Uzhe proveril (macroexpand-1).

> А совсем без функции, чисто на макросах никак нельзя?

"Рекурсивный макрос" не может использовать самого себя в процессе "раскрытия" (компиляции) - только в теле создаваемого кода.

Т.е. так можно:

(defmacro !1 (x) (if (= x 1) 1 `(* ,x (!1 ,(1- x)))))

но на выходе ты получишь не значение, а цепочку умножений:

CL-USER> (SB-CLTL2:MACROEXPAND-ALL '(!1 5))

(* 5 (* 4 (* 3 (* 2 1))))

А так нельзя:

(defmacro !1 (x) (if (= x 1) 1 (* x (!1 (1- x)))))

и не потому, что макрос обязательно должен вернуть код - нет, он может вернуть и конкретное значение. Но, во-первых, форма !1 должна быть определена на момент "компиляции" макроса, чего в момент объявления макроса нет, и, во-вторых, в выражении

(!1 (1- x))

макросу будет передано не число, а список.

>> или используй #.

> Что это?

Ёпрст! БУКВАРЬ!!!

http://www.lisp.org/HyperSpec/Body/sec_2-4-8-6.html

> форма !1 должна быть определена на момент "компиляции" макроса

прогон. Но момент объявления. Но всё равно будут варнинги и в конце концов "сработает" "вторая часть"

> Что это?

Примерчик:

(eval-when (:compile-toplevel :load-toplevel :execute) (defun fact (x) (if (< x 2) 1 (* x (fact (1- x))))))

(print '(it is number - #.(fact 42)))

Спасибо за объяснения!

Но если рекурсивных макросов нет, то как без них обходятся?

Допустим есть более практичный пример: преобразователь кода вида 
[expr1 [expr2 arg1 arg2 [expr4]] arg3 [expr5]]
в соответствующую лисповую конструкцию
(expr1 (expr2 arg1 arg2 (expr4)) arg3 (expr5))

Т.к. на выходе код и на выходе код, то логично использовать макрос.
Т.к. конструкция рекурсивная, то макрос должен уметь обрабатывать такие
конструкции.
Самый прямой способ обрабатывать рекурсивные конструкции - это
рекурсивно вызывать этот же макрос для обработки вложенных конструкций.
Но рекурсивных макросов в CL как мы выяснили нет.

В сумме получаем проблему.
Или не получаем?

> Но если рекурсивных макросов нет, то как без них обходятся?

Тебе же все объяснили :) Рекурсивно вызывать макрос можно, но сгенерится дерево кода -- (* 3 (* 2 (* 1))). Если тебе просто нужна итерация или цикл -- не стесняйся его использовать из макры. Если просто нужна рекурсия (для обхода дерева, например), определи эту функцию, и дергай ее из макры.

Или прямо внутри макры: (defmacro macrofact (x) (labels ((fact (n) (if (zerop n) 1 (* n (fact (1- n)))))) (fact x)))

Меня смущает необходимость использования функций для обработки кода. В мозгу прочно сидить "если нужно обрабатывать код, то нужен макрос". :)

Вобщем надо ещё поиграться.

> Но если рекурсивных макросов нет, то как без них обходятся?

Они есть. И их можно использовать. Для построения вложенных цепочек - не для получения конкретных значений. Т.е резултатом выполнения макроса будет код, в котором будет стоять вызов этого макроса, резултатом выполнения которого будет код, в котром... в конце твой макрос должен вернуть предельное значение/код без вызова себя для прекращения рекурсии.

С примером не понял. Напиши коротенький примерчик - из какого списка (кода) какой хочешь получить - подумаем :)

> Меня смущает необходимость использования функций для обработки кода. В мозгу прочно сидить "если нужно обрабатывать код, то нужен макрос". :)

Не надо этого смущаться - совершенно нормальная практика. Грубо - макрос, это функция, которая возвращает список (код), который вставляется в месте его вызова. А как получить этот список - твоё личное дело. Нередко можно увидеть даже такое:

(defmacro my-macro () (my-func))

Я намеренно упростил и выкинул аргументы - макрос просто вернёт список, который получит от функции my-func.

> Допустим есть более практичный пример: преобразователь кода вида 
> [expr1 [expr2 arg1 arg2 [expr4]] arg3 [expr5]]
> в соответствующую лисповую конструкцию
> (expr1 (expr2 arg1 arg2 (expr4)) arg3 (expr5))

Можно хаком, но я решил продемонстрировать концепцию (scheme).

Использование: (execve->lisp "{+ 3 4 {- 10 2} 7}")

Код:

(require 'regex)

(define-macro (execve->lisp expr)
  (car (parse-list expr)))

(define parse-list
  (lambda (terms-list)
    (parse-list-ready (skip-leading-whitespaces terms-list))))

(define skip-leading-whitespaces
  (lambda (string) (string-substitute "^\\s+" "" string)))

(define parse-list-ready
  (lambda (terms-list)
    (if (zero? (string-length terms-list))
        '()
        (let ((first-term-proc (extract-first-term terms-list)))
          (first-term-proc
           (lambda (first-term rest-terms)
             (cons first-term (parse-list rest-terms))))))))

(define extract-first-term
  (lambda (terms-list)
    (if (char=? #\{ (string-ref terms-list 0))
        (extract-function terms-list)
        (extract-term terms-list))))

(define extract-function
  (lambda (terms-list)
    (let ((function-end-index (search-closing-paren terms-list 1)))
      (lambda (proc)
        (proc (parse-list (string-copy terms-list
                                       1
                                       (- function-end-index 1)))
              (string-copy terms-list
                           function-end-index
                           (string-length terms-list)))))))

(define search-closing-paren
  (lambda (string index)
    (search-closing-paren-count string index 1)))

(define search-closing-paren-count
  (lambda (string index count)
    (if (zero? count)
        index
        (let ((current (string-ref string index)))
          (search-closing-paren-count
           string
           (+ index 1)
           (cond
            ((char=? #\{ current) (+ count 1))
            ((char=? #\} current) (- count 1))
            (else count)))))))

(define extract-term
  (lambda (terms-list)
    (let ((term-match (string-match "^(\\S+).*" terms-list)))
      (lambda (proc)
        (proc (string->scheme (cadr term-match))
              (string-substitute "^(\\S+)"
                                 ""
                                 terms-list))))))

(define string->scheme
  (lambda (string)
    (if (string-match "^\\d+$" string)
        (string->number string)
        (string->symbol string))))

>Допустим есть более практичный пример: преобразователь кода вида 
>[expr1 [expr2 arg1 arg2 [expr4]] arg3 [expr5]]
>в соответствующую лисповую конструкцию
>(expr1 (expr2 arg1 arg2 (expr4)) arg3 (expr5))

Тебе эту конструкцию надо прямо в твоем DSL использовать? Если да, то 
посмотри, то как это сделано в CLSQL, например. А сделано это там через
 reader macro. Файлик clsql/sql/syntax.lisp. Он совсем маленький. Но 
если у тебя есть возможность избежать изменения синтаксиса такого 
характера, то лучше его избежать и использовать стандартный, 
неизмененный read.

Вот так выглядит код, написаный с CLSQL. 

(deftest :syntax/aggregate/1
    (clsql:sql [max [+ [foo] [* 1000 [bar]]]])
 "MAX((FOO + (1000 * BAR)))")

Да ладно, тут его выкину, чтобы не искал. 

*sql-macro-open-char* -- это открывающая скобочка
*sql-macro-close-char* -- это закрывающая скобочка

Новый macro-char назначается в enable-sql-reader-syntax и 
определяется для него функция разбора sql-reader-open

Сброс назад с лисповый reader в disable-sql-...


(in-package #:clsql-sys)

(defvar *original-readtable* nil)

(defvar *sql-macro-open-char* #\[)

(defvar *sql-macro-close-char* #\])

(defvar *restore-sql-reader-syntax* nil)


;; Exported functions for disabling SQL syntax.

(defmacro disable-sql-reader-syntax ()
  "Turns off the SQL reader syntax setting the syntax state such
that if the syntax is subsequently enabled,
RESTORE-SQL-READER-SYNTAX-STATE will disable it again."
  '(eval-when (:compile-toplevel :load-toplevel :execute)
    (setf *restore-sql-reader-syntax* nil)
    (%disable-sql-reader-syntax)))

(defmacro locally-disable-sql-reader-syntax ()
  "Turns off the SQL reader syntax without changing the syntax
state such that RESTORE-SQL-READER-SYNTAX-STATE will re-establish
the current syntax state."
  '(eval-when (:compile-toplevel :load-toplevel :execute)
    (%disable-sql-reader-syntax)))

(defun %disable-sql-reader-syntax ()
  (when *original-readtable*
    (setf *readtable* *original-readtable*
          *original-readtable* nil))
  (values))


;; Exported functions for enabling SQL syntax.

(defmacro enable-sql-reader-syntax ()
  "Turns on the SQL reader syntax setting the syntax state such
that if the syntax is subsequently disabled,
RESTORE-SQL-READER-SYNTAX-STATE will enable it again."
  '(eval-when (:compile-toplevel :load-toplevel :execute)
    (setf *restore-sql-reader-syntax* t)
    (%enable-sql-reader-syntax)))

(defmacro locally-enable-sql-reader-syntax ()
  "Turns on the SQL reader syntax without changing the syntax
state such that RESTORE-SQL-READER-SYNTAX-STATE will re-establish
the current syntax state."
  '(eval-when (:compile-toplevel :load-toplevel :execute)
    (%enable-sql-reader-syntax)))

(defun %enable-sql-reader-syntax ()
  (unless *original-readtable*
    (setf *original-readtable* *readtable*
          *readtable* (copy-readtable))
    (set-macro-character *sql-macro-open-char* #'sql-reader-open)
    (set-macro-character *sql-macro-close-char* (get-macro-character #\))))
  (values))

(defmacro restore-sql-reader-syntax-state ()
  "Enables the SQL reader syntax if ENABLE-SQL-READER-SYNTAX has
been called more recently than DISABLE-SQL-READER-SYNTAX and
otherwise disables the SQL reader syntax. By default, the SQL
reader syntax is disabled."
  '(eval-when (:compile-toplevel :load-toplevel :execute)
    (if *restore-sql-reader-syntax*
        (%enable-sql-reader-syntax)
        (%disable-sql-reader-syntax))))

(defun sql-reader-open (stream char)
  (declare (ignore char))
  (let ((sqllist (read-delimited-list #\] stream t)))
    (unless *read-suppress*
      (handler-case
          (cond ((string= (write-to-string (car sqllist)) "||")
                 (cons (sql-operator 'concat-op) (cdr sqllist)))
                ((and (= (length sqllist) 1) (eql (car sqllist) '*))
                 (apply #'generate-sql-reference sqllist))
                ((sql-operator (car sqllist))
                 (cons (sql-operator (car sqllist)) (cdr sqllist)))
                (t (apply #'generate-sql-reference sqllist)))
        (sql-user-error (c)
          (error 'sql-user-error
                 :message (format nil "Error ~A occured while attempting to parse '~A' at file position ~A"
                                  (sql-user-error-message c) sqllist (file-position stream))))))))

(defun generate-sql-reference (&rest arglist)
  (cond ((= (length arglist) 1) ; string, table or attribute
         (if (stringp (car arglist))
             (sql-expression :string (car arglist))
             (sql-expression :attribute (car arglist))))
        ((<= 2 (length arglist))
         (let ((sqltype (when (keywordp (caddr arglist)) (caddr arglist) nil)))
           (cond
             ((stringp (cadr arglist))
             (sql-expression :table (car arglist)
                             :alias (cadr arglist)
                             :type sqltype))
            ((keywordp (cadr arglist))
             (sql-expression :attribute (car arglist)
                             :type (cadr arglist)))
            (t
             (sql-expression :attribute (cadr arglist)
                             :table (car arglist)
                             :type sqltype)))))
        (t
         (error 'sql-user-error :message "bad expression syntax"))))


;; Exported functions for dealing with SQL syntax

(defun sql (&rest args)
  "Returns an SQL string generated from the expressions ARGS. The
expressions are translated into SQL strings and then concatenated
with a single space delimiting each expression. An error of type
SQL-USER-ERROR is signalled if any element in ARGS is not of the
supported types (a symbol, string, number or symbolic SQL
expression) or a list or vector containing only these supported
types."
  (format nil "~{~A~^ ~}" (mapcar #'sql-output args)))

(defun sql-expression (&key string table alias attribute type)
  "Returns an SQL expression constructed from the supplied
arguments which may be combined as follows: ATTRIBUTE and TYPE;
ATTRIBUTE; ALIAS or TABLE and ATTRIBUTE and TYPE; ALIAS or TABLE
and ATTRIBUTE; TABLE, ATTRIBUTE and TYPE; TABLE and ATTRIBUTE;
TABLE and ALIAS; TABLE; and STRING. An error of type
SQL-USER-ERROR is signalled if an unsupported combination of
keyword arguments is specified."
  (cond
    (string
     (make-instance 'sql :string string))
    (attribute
     (make-instance 'sql-ident-attribute  :name attribute
                    :qualifier (or table alias)
                    :type type))
    ((and table (not attribute))
     (make-instance 'sql-ident-table :name table
                    :table-alias alias))))

(defun sql-operator (operator)
  "Returns the Lisp symbol corresponding to the SQL operator
  represented by the symbol OPERATOR. If OPERATOR does not
  represent a supported SQL operator or is not a symbol, nil is
  returned."
  (typecase operator
    (string nil)
    (symbol (values (gethash (symbol-name-default-case (symbol-name operator))
                             *sql-op-table*)))))

(defun sql-operation (operator &rest args)
  "Returns an SQL expression constructed from the supplied symbol
OPERATOR representing an SQL operator or function and its
arguments ARGS. An error of type SQL-USER-ERROR is signalled if
OPERATOR is not a symbol representing a supported SQL
operator. If OPERATOR is passed the symbol FUNCTION then the
first value in ARGS must be a string representing a valid SQL
function and the remaining values in ARGS its arguments as
strings."
  (if (sql-operator operator)
      (apply (symbol-function (sql-operator operator)) args)
      (error 'sql-user-error
             :message
             (format nil "~A is not a recognized SQL operator." operator))))

Рискну преположить, что в Схеме (или в одной из ее реализаций bigloo) можно сделать так, чтобы квадратные скобочки использовались прямо в программе, а не передавались в виде quoted string, как у тебя (execve->lisp "{+ 3 4 {- 10 2} 7}")

Как пример, есть такая замечательная вещь, как Scribe -- это язык разметки, но сделанный исключительно на базе Scheme. И вот пример кода такой разметки (обрати внимание на скобочки квадратные).

http://www-sop.inria.fr/mimosa/fp/Scribe/scribe-2.html#container1096

Но так как я не знаю конкретики ни Scheme, ни Scribe, то не могу определенно сказать, как эти файлы обрабатываются. Либо они как одна большая строка обрабатываются (то есть получается, как у тебя, и пока я предполагаю, что так это и есть), либо там все-таки есть какой-то механизм подмены а-ля reader macro из CL (в чем я сомневаюсь). Если инетересно, можешь там исходник стянуть.

> Рискну преположить, что в Схеме (или в одной из ее реализаций bigloo) можно сделать так, чтобы квадратные скобочки использовались прямо в программе

Это фишка такая некоторых схемо-реализаций -- квадратные скобки так тождественно равны круглым. Просто для удобочитаемости. У меня емакс, например, вообще на этапе набора квадратные скобки на круглые меняет :)

> Scribe -- это язык разметки, но сделанный исключительно на базе Scheme. И вот пример кода такой разметки (обрати внимание на скобочки квадратные).

> не могу определенно сказать, как эти файлы обрабатываются. Либо они как одна большая строка обрабатываются (то есть получается, как у тебя, и пока я предполагаю, что так это и есть), либо там все-таки есть какой-то механизм подмены а-ля reader macro из CL (в чем я сомневаюсь).

Посмотрел. Все так и есть -- сам читает из файла и парсит :) Но вообще reader macros относительно прямо реализуются в схеме (см. например, srfi-10), а некоторые реализации схемы (plt-scheme, например), поддерживающие syntax-case, вполне радуют пользователей: http://scheme.dk/blog/2007/04/fun-with-macros-extending-application.html

А вообще исходный пример, который я показывал, реализуется слету: (with-input-from-string "(+ 3 4)" (lambda () (eval (read)))) -- единственно, в исходной строчке надо пройтись регуляркой и заменить все "{}" на "()" :) Я просто показывал концепцию с макросами

>Я просто показывал концепцию с макросами

Ну если парсить в макросе конструкцию из строки "[foo [bar expr]]", то подход в CL ничем не будет отличаться от приведенного тобой. Все также придется аккуратно отследить парные скобочки (не просто заменить!), чтобы не нарваться на такие вещи, как #\[ , которые могут содержаться в expr, заменить найденное на "(" и ")", а дальше уже творить с полученным списком "(foo (bar expr))", что угодно. Все эти действия будут производиться в macroexpantion-time перед компиляцией.

А reader macro уже позволит большее -- использовать определенный пользователем синтаксис напрямую в REPL и программах без преобразующих макросов. И весь этот механизм прописан в стандарте ANSI, а не implementation specific. То, что в PLT Scheme есть некоторое подобие reader macros -- это очень здорово!

Да кто ж спорит-то со всем этим :) Я совсем не хочу устраивать холивор между scheme и cl -- я обоих люблю =))

Там изначально вопрос ставился человеком примерно так: "Мы выяснили, что рекурсивных макросов в лиспе нет. Как же тогда решается следующая задача...". Я просто показал мужику как =)