LINUX.ORG.RU

Как на макросах изобразить инстанциирование

 , ,


2

3

Есть макрос, который должен создавать функцию.

(defmacro build (info) `(lambda ...))

Текст функции зависит от содержимого структуры info.

Где-то в коде он многократно вызывается с разными параметрами. Можно ли как-то сделать, чтобы он при первом запуске где-то создавал функцию, а при последующих только ссылался на неё? То есть нужен механизм, аналогичный инстанциированию шаблонов C++.

Есть какие-нибудь идеи, как сделать? Реализация лиспа (CL, Scheme, ...) не важна.

★★★★★

Заводишь где-нибудь «контейнер» функций. В макре смотришь, если функция еще не сгенерирована, генерируешь код самой функции, добавления ее в этот контейнер и возвращающий ее, если уже сгенерирована — генерируешь код, достающий ее оттуда.

ИМХО ситуация довольно нестандартная. И вообще инстанцирование шаблонов в С++ и генерация функций в лиспе — две большие разницы.

staseg ★★★★★ ()

Можно попробовать и без макр обойтись:

(defparameter *functions-cache*
  (make-hash-table :test 'equalp))

(defstruct expr oper op1 op2)

(defun build (info)
  (aif (gethash info *functions-cache*)
       it
       (setf (gethash info *functions-cache*)
               (lambda ()
                 (funcall (expr-oper info)
                          (expr-op1 info)
                          (expr-op2 info))))))

В любом случае, логика будет похожая.

theNamelessOne ★★★★★ ()
Последнее исправление: theNamelessOne (всего исправлений: 1)
Ответ на: комментарий от staseg

Заводишь где-нибудь «контейнер» функций.

Вот в этом и есть главный вопрос. Где?

Контейнер должен в виде текста попасть в начало файла, полученного после развёртки исходников. Но как поменять начало текста после чтения (экспанда) всего файла?

monk ★★★★★ ()
Ответ на: комментарий от theNamelessOne

Можно попробовать и без макр...

Выглядеть должно так:

(build-function sum (x) 
  (iterate over table accounts calling +))

(build-function build-menu ()
  (make-with-gtk from-file "menu.xml"))

....

Есть «компилятор» из этого языка в CL. Но без макр придётся «компилировать» при каждом запуске программы.

monk ★★★★★ ()
Ответ на: комментарий от monk

Контейнер должен в виде текста попасть в начало файла, полученного после развёртки исходников.

Как разработчик макроса ты можешь сам задать этот контейнер прямо перед кодом самого макроса. Генерировать код создания контейнера не надо.

staseg ★★★★★ ()

Есть какие-нибудь идеи, как сделать?

http://ru.wikipedia.org/wiki/Мемоизация

Реализация лиспа (CL, Scheme, ...) не важна.

Есть лиспы, где макросы выкинули (troll-mode за ненадобностью)

anonymous ()
(defmacro build [data-in]
	(let [isset (resolve 'build-create)]
		(if isset
			`(cond (= (first ~data-in) :tag1) 'true-from-already-create :else 'false-from-already-create)
			`(do
				(def build-create true)
				(println 'created)
				(cond (= (first ~data-in) :tag1) 'true-from-after-create :else 'false-from-after-create)))))

как насчет такого?

rikardoac ()
Ответ на: комментарий от staseg

Как разработчик макроса ты можешь сам задать этот контейнер прямо перед кодом самого макроса. Генерировать код создания контейнера не надо.

Так у меня содержимое контейнера должно как-то попасть в код программы.

Или можешь предложить пример?

Возьмём такой вариант:

(defmacro build (body)
  `(eval body))

Надо чтобы кусок кода

(defun test1 (x)
  (+ (build (+ 2 x)) (build (+ 2 x)))

(defun test2 (x)
  (build (+ 2 x)))

Раскрылся в

(defun |(+ 2 x)| (x) 
  (eval (+ 2 x)))

(defun test1 (x)
   (+ (|(+ 2 x)| x) (|(+ 2 x)| x)))

(defun test1 (x)
   (|(+ 2 x)| x))

monk ★★★★★ ()
Ответ на: комментарий от rikardoac

как насчет такого?

А в контексте

(def test1 (fn [x] (build :tag1))
(def test2 (fn [x] (build :tag1))

работать будет?

monk ★★★★★ ()
Ответ на: комментарий от monk

Почему нет? Только я предполагал, что в build будет передаваться последовательность и уже дальше как-то будет обрабатываться по тегу(:tag1 :tag2 etc) в car.

(defmacro build [data-in]
	(let [isset (resolve 'build-create)]
		(if isset
			`(cond (= (first ~data-in) :tag1) #(println %1) :else 'false-from-already-create)
			`(do
				(def build-create true)
				(println 'created)
				(cond (= (first ~data-in) :tag1) #(println %1) :else 'false-from-after-create)))))
user=> (def x (build [:tag1]))
user/created
#'user/x
user=> (x 1)
1
nil
user=> (def y (build [:tag2]))
#'user/y
user=> (y 2)
nil
user=> y
user/false-from-already-create

rikardoac ()
Ответ на: комментарий от rikardoac

(def x (build [:tag1]))

Не так. (def x (fn () (build [:tag1])))

monk ★★★★★ ()
Ответ на: комментарий от monk

Я сначала думал, речь просто о кешировании генерации одинаковых функций вроде:

(defmacro make-fun ((&rest args) &rest body)
 `(lambda ,args ,@body))

(funcall (make-fun (a b) (+ a b)) 1 2) ;создаем функцию для a b (+ a b)
(funcall (make-fun (a b) (+ a b)) 3 4) ;используем существующую
(funcall (make-fun (a b) (+ a b 42)) 1 2) ;создаем новую

И чтобы для одинаковой сигнатуры/кода генерировалась одна функция и подставлялась при каждом таком же вызове макроса. Из этого примера я вообще не понимаю логики раскрытия макры, откуда например взять сигнатуру функции:

(defun |(+ 2 x)| (x) 
  (eval (+ 2 x)))

То есть понять, что она получает один параметр? Выдирать все символы из списка (+ 2 x) нельзя. Или ты имел в виду что-то другое, записывая код макроса build?

staseg ★★★★★ ()
Ответ на: комментарий от staseg

И чтобы для одинаковой сигнатуры/кода генерировалась одна функция и подставлялась при каждом таком же вызове макроса.

Согласен, твой пример наглядней.

То есть необходимо, чтобы было

(eq (make-fun (a b) (+ a b)) 
    (make-fun (a b) (+ a b))) => t

monk ★★★★★ ()
Ответ на: комментарий от monk

То есть в лоб, конечно решается через

[(defmacro make-fun ((&rest args) &rest body)
  (let ((key (cons args body)))
   `(or (gethash *funcs* ,key)
        (setf (gethash *funcs* ,key) 
              (lambda ,args ,@body)))))

Но при этом куски кода будут многократно компилироваться и на каждый вызов я получаю лишний gethash. Хочется как в C++ :-) Написал min(3, 4) и где-то инстанциировался экземпляр шаблона для целых чисел (единожды).

monk ★★★★★ ()
Ответ на: комментарий от monk

Или понадеяться, что компилятор умный и идентичные лямбды сам объединит....

monk ★★★★★ ()
Ответ на: комментарий от monk

Ну вот сначала я и предлагал вариант в лоб :)

Вроде есть мысль, как сделать без gethash в рантайме, сейчас попробую.

Или понадеяться, что компилятор умный и идентичные лямбды сам объединит....

(eq (lambda (x) x) (lambda (x) x)) ;=>NIL

Clozurecl.

staseg ★★★★★ ()
Ответ на: комментарий от monk

И так отрабатывает:

user=> (def x (fn [] (build [:tag1])))
#'user/x
user=> ((x) 1)
1
nil
user=> 

rikardoac ()
Ответ на: комментарий от rikardoac

Я немножко про другое

(defmacro build [data-in] ...)
(def x (fn [] (build [:tag1])))
(def y (fn [] (build [:tag1])))
((x) 1)
((y) 1)

Запущенный из чистой сессии дважды напишет created.

monk ★★★★★ ()
Ответ на: комментарий от monk

Странно, у меня только в первом случае пишет created. Кстати, я использую clojure 1.5

;; repl
user=> (def x (fn [] (build [:tag1])))
#'user/x
user=> (def y (fn [] (build [:tag1])))
#'user/y
user=> ((x) 1)
user/created
1
nil
user=> ((y) 1)
1
nil
;; sometest/test.clj
(ns sometest.test)

(defmacro build [data-in]
        (let [isset (resolve 'build-create)]
                (if isset
                        `(cond (= (first ~data-in) :tag1) #(println %1) :else 'false-from-already-create)
                        `(do
                                (def build-create true)
                                (println 'created)
                                (cond (= (first ~data-in) :tag1) #(println %1) :else 'false-from-after-create)))))

(def x (fn [] (build [:tag1])))
(def y (fn [] (build [:tag1])))
((x) 1)
((y) 1)


java -cp clojure-1.5.1.jar:$PWD clojure.main sometest/test.clj 
sometest.test/created
1
1

rikardoac ()
Ответ на: комментарий от monk

Так в чем проблема сделать в первой фазе глобальный хеш, в котором будут лежать имена инстанцированных функции? Если в хеше пусто - то создается функция, если непусто (функция уже создана) просто подставляем нужное имя из хеша.

Естественно, передавать в такую функцию можно только константы.

anonymous ()
Ответ на: комментарий от rikardoac

Странно, у меня только в первом случае пишет created.

Загадочно. Значит я плохо знаю clojure. Я предположил, что build раскрывается в первую или вторую ветку в зависимости от состояния build-create в момент компиляции. А определяется build-create определённо в момент выполнения программы.

Получается, что clojure раскрывает макросы уже в процессе выполнения? Или я опять синтаксис не так понял?

monk ★★★★★ ()
Ответ на: комментарий от monk

Можно применить compile:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *funcs* (make-hash-table :test 'equalp)))

(defmacro make-fun ((&rest args) &body body)
  (let ((key (cons args body)))
    `#',(or (gethash key *funcs*)
            (setf (gethash key *funcs*)
                  (let ((name (intern (format nil "~s" key))))
                    (compile name `(lambda ,args ,@body))
                    name)))))

(defun test ()
  (values (funcall (make-fun (a b) (+ a b))    1 2)
          (funcall (make-fun (a b) (+ a b))    3 4)
          (funcall (make-fun (a b) (+ a b 42)) 1 2)))
CL-USER[1]: (compile-file #p"test.lisp")

; compiling file "/tmp/test.lisp" (written 13 SEP 2013 02:48:07 PM):
; compiling (DEFVAR *FUNCS* ...)
; compiling (DEFMACRO MAKE-FUN ...)
; compiling (DEFUN TEST ...)

; /tmp/test.fasl written
; compilation finished in 0:00:00.052
#P"/tmp/test.fasl"
NIL
NIL
CL-USER[2]: (load *)
T
CL-USER[3]: (test)
3
7
45

Я сначала хотел использовать gensym вместо intern, но в SBCL безпакетные символы, по-видимому, теряют идентичность, когда хранятся в fasl в нескольких местах. В данном случае не совпадали значения в хеш-таблице и то, что было подставлено в код после раскрытия make-fun. Любопытно, что при этом значение в хеш-таблице было связано с функцией. Мне пока дальше лень разбираться.

anonymous ()
Ответ на: комментарий от anonymous

Так в чем проблема сделать в первой фазе глобальный хеш, в котором будут лежать имена инстанцированных функции?

В том, что после экспанда надо как-то вставить эти функции из хэша в текст программы. Иначе при загрузке скомпилированной программы всё пропадёт.

Причём вставлять желательно до точки вызова, иначе будут ошибки типа «функция не определена».

monk ★★★★★ ()
Ответ на: комментарий от anonymous
[1]> (load "test.fas")
;; Загружается файл test.fas...
;; Загружен файл test.fas
T
[2]> (test)

*** - FUNCALL: функция |((A B) (+ A B))| не определена
Имеются следующие варианты продолжения:
USE-VALUE      :R1      Input a value to be used instead of (FDEFINITION '|((A B) (+ A B))|).
RETRY          :R2      Еще раз
STORE-VALUE    :R3      Input a new value for (FDEFINITION '|((A B) (+ A B))|).
ABORT          :R4      Прервать главный цикл
monk ★★★★★ ()
Ответ на: комментарий от anonymous

У тебя ошибка: ты используешь при выполнении функцию, которая появляется только в процессе компиляции.

monk ★★★★★ ()
Ответ на: комментарий от anonymous

Кстати, при использовании intern хеш вообще не нужен, так как нужная функция однозначно определяется своим именем.

(defmacro make-fun ((&rest args) &body body)
  (let ((name (intern (format nil "~s" (cons args body)))))
    (unless (fboundp name)
      (compile name `(lambda ,args ,@body)))
    `#',name))
anonymous ()
Ответ на: комментарий от monk

У тебя ошибка: ты используешь при выполнении функцию, которая появляется только в процессе компиляции.

Это какую же? У меня всё работает, SBCL-1.0.57

anonymous ()
Ответ на: комментарий от staseg
(defun mkstr (&rest args)
 (with-output-to-string (s)
   (dolist (x args) (princ x s))))

(let ((cache (make-hash-table)))
 (defmacro make-fun ((&rest args) &rest body)
  (let ((name (intern (mkstr (list args body)))))
   (or (gethash name cache)
       (setf (gethash name cache)
	     (eval `(compile nil (lambda ,args ,@body))))))))

Смысл в том, что лямбда компилируется прямо во время раскрытия макроса. Минус — сломаются замыкания между body и окружением вызова make-fun.

(eq (make-fun (x) 1) (make-fun (x) 1)); eval; => T

(defun xx ()
 (eq (make-fun (x) 1) (make-fun (x) 1))); Compile
(xx); => T

(defun xx (x)
 (funcall (make-fun (a) (+ a x)) 1)); Suxx.

UPD. Анон меня опередил :)

staseg ★★★★★ ()
Последнее исправление: staseg (всего исправлений: 2)
Ответ на: комментарий от anonymous

У меня всё работает, SBCL-1.0.57

Запусти вот так:

$ sbcl --load test.fasl --eval '(test)'

У меня ожидаемо выдаёт:

This is SBCL 1.1.8, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.

debugger invoked on a UNDEFINED-FUNCTION in thread
#<THREAD "main thread" RUNNING {AC3AB41}>:
  The function COMMON-LISP-USER::|((A B) (+ A B))| is undefined.

monk ★★★★★ ()
Ответ на: комментарий от anonymous
(defun mkstr (&rest args)
 (with-output-to-string (s)
   (dolist (x args) (princ x s))))

(let ((cache (make-hash-table)))
 (defmacro make-fun ((&rest args) &rest body)
  (let ((name (intern (mkstr (list args body)))))
   (or (gethash name cache)
       (setf (gethash name cache)
	     (eval `(compile nil (lambda ,args ,@body))))))))

(defun xx ()
 (eq (make-fun (x) 1) (make-fun (x) 1)))
* (compile-file "test2")

...
; caught ERROR:
;   Objects of type FUNCTION can't be dumped into fasl files.
...
monk ★★★★★ ()
Последнее исправление: monk (всего исправлений: 2)
Ответ на: комментарий от monk

В том, что после экспанда надо как-то вставить эти функции из хэша в текст программы.

Ну так вставляй соответствующие имена. Я же описал алгоритм работы. Не понимаю, в чем проблема.

anonymous ()
Ответ на: комментарий от monk

Ага, понял, оно во время компиляции связало символ с функцией. Это объясняет gensym... Ну тогда у меня есть ещё одна идея: собрав объявления, скомпилировать их в конце обработки файла таким образом:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *funcs* (make-hash-table :test 'equalp)))

(defmacro make-fun ((&rest args) &body body)
  (let ((key (cons args body)))
    `#',(or (gethash key *funcs*)
            (setf (gethash key *funcs*) (gensym)))))

(defmacro define-functions ()
  (let (body)
    (maphash (lambda (key value)
               (push `(defun ,value ,@key) body))
             *funcs*)
    `(progn ,@body)))

(defun test ()
  (list (funcall (make-fun (a b) (+ a b))    1 2)
        (funcall (make-fun (a b) (+ a b))    3 4)
        (funcall (make-fun (a b) (+ a b 42)) 1 2)))

(define-functions)
[tmp]> sbcl --noinform --no-sysinit --no-userinit --eval '(progn (compile-file #p"test.lisp") (quit))'

; compiling file "/tmp/test.lisp" (written 13 SEP 2013 03:14:23 PM):
; compiling (DEFVAR *FUNCS* ...)
; compiling (DEFMACRO MAKE-FUN ...)
; compiling (DEFMACRO DEFINE-FUNCTIONS ...)
; compiling (DEFUN TEST ...)
; compiling (DEFINE-FUNCTIONS)

; /tmp/test.fasl written
; compilation finished in 0:00:00.031
[tmp]> sbcl --noinform --no-sysinit --no-userinit --eval '(progn (load #p"test.fasl") (format t "~s~%" (test)) (quit))'
(3 7 45)
anonymous ()
Ответ на: комментарий от monk

Придумался хардкорный вариант:

В клиентском коде требую первой строкой (load «generated»).

В макросе всё, что определяется, пишется туда (и дополнительно интернится). Сам код generated выглядит как

#-generated(progn
(pushnew :generated *features*)
...
(defun ...)

(defun ...)
...)

Таким образом, если файлов несколько, то generated загрузится единжды.

Правда генерация кода компилятором меня слегка смущает. Это вообще нормальный подход?

monk ★★★★★ ()
Ответ на: комментарий от anonymous

(define-functions)

Да. Это красивый вариант. Мне нравится.

monk ★★★★★ ()
Ответ на: комментарий от anonymous

#'...

Это ведь раскрывается в (function ...)? Компилятор выполняет этот вызов во время компиляции или в рантайме ищет нужную функцию (все равно что делать самому gethash)?

staseg ★★★★★ ()
Последнее исправление: staseg (всего исправлений: 1)
Ответ на: комментарий от staseg

В общем, если (function) дешевая, у меня сразу был такой вариант. На SBCL не могу проверить.

(defun mkstr (&rest args)
 (with-output-to-string (s)
   (dolist (x args) (princ x s))))

(let ((cache (make-hash-table)))
 (defmacro make-fun ((&rest args) &rest body)
  (let ((name (intern (mkstr (list args body)))))
   (if (gethash name cache)
       `(function ,name)
       (progn
	(setf (gethash name cache) t)
	`(defun ,name ,args ,@body))))))

UPD. В Clozecl работает через -load/(compile-file). Замыкания работают.

staseg ★★★★★ ()
Последнее исправление: staseg (всего исправлений: 1)
Ответ на: комментарий от staseg

function --- специальный оператор, и здесь он раскрывается во время компиляции. Точно не знаю во что именно, скорее всего в вызов функции по указателю, может, по двойному указателю. Функции в Common Lisp можно переопределять, при этом использующие их функции будут использовать новое определение без перекомпляции (во всяком случае, при не слишкой агрессивной оптимизации). Так что стоимость (funcall #'my-symbol ...), я думаю, будет не больше чем стоимость (my-symbol ...), ну а my-symbol здесь генерируется и подставляется во время компиляции.

anonymous ()

Так чем не устраивает

#lang racket
(require syntax/parse/define)

(begin-for-syntax 
  (define instance-hash (make-hash)))

(define-simple-macro (define-template (name:id arg:id ...) body:expr ...)
  (define-simple-macro (name arg ... )
    #:do [(define args (syntax->datum #'(arg ...)))]
    #:with hidden (hash-ref! instance-hash args (syntax-local-lift-expression #'(begin body ...)))
    hidden))

(define-template (yoba x) 
  (λ (y) (+ x y)))

((yoba 1) 5)
((yoba 2) 5)
((yoba 1) 5)
? (yoba 1) и (yoba 2) создаются по одному разу

anonymous ()
Ответ на: комментарий от anonymous

Так чем не устраивает

А вот это реально круто. «A run-time expression within a module is lifted to the module’s top level, just before the expression whose expansion requests the lift.» — собственно та самая проблема из-за которой в CL приходится внизу дописывать (define-functions).

Спасибо!

monk ★★★★★ ()
Ответ на: комментарий от monk

Только по-хорошему там, конечно, не (syntax->datum #'(arg ...)) надо, а сделать враппер вокруг syntax j,ject и определить для него gen:equal+hash

anonymous ()
Ответ на: комментарий от anonymous

Это как раз понятно. Непонятно, как это отлаживать. В макростеппере

((yoba 1) 5)
((yoba 2) 5)
((yoba 1) 5)

Превращается в

(lifted.0 5)
(lifted.2 5)
(lifted.0 5)

при полном отсутствии определений для lifted.0 и lifted.2

Куда потыкать?

monk ★★★★★ ()
Ответ на: комментарий от monk

при полном отсутствии определений для lifted.0 и lifted.2

Определения есть, просто надо hide-галочки убрать в левом нижнем углу.

Еще там (lambda () (syntax-local-lift-expression #'(begin body ...))) вместо (syntax-local-lift-expression #'(begin body ...)) надо.

anonymous ()
Ответ на: комментарий от anonymous

Точно. Увидел. Ещё раз огромное спасибо. Пойду перечитывать про синтаксические преобразователи в Racket. Много пропустил, оказывается.

monk ★★★★★ ()
Ответ на: комментарий от monk

Я сейчас вот еще что хотят добавить, вообще:

Right — there's currently no way to lift a module declaration
after expansion starts working on expressions within a module.

I think that operation could be added, and I'll look into it as soon as possible.

anonymous ()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.