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

(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))))))

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

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

....

(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)))))

(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))

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

(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

(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)))

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

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

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

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

;; 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

(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

[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      Прервать главный цикл

(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))

(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))))))))

(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.

$ 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.

(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.
...

(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)

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

(defun ...)
...)

(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))))))

#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) 5)
((yoba 2) 5)
((yoba 1) 5)

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