I have a list of the names of slots of a CLOS object:
(DEFCLASS TRIAL-DATA (STANDARD-OBJECT)
((A-DATUM :ACCESSOR A-DATUM :INITARG :A-DATUM :INITFORM NIL)
(BOTH-DATA :ACCESSOR BOTH-DATA :INITARG :BOTH-DATA :INITFORM 0)
(CUMULATIVE-DATA :ACCESSOR CUMULATIVE-DATA :INITARG :CUMULATIVE-DATA :INITFORM NIL)
(NAME :ACCESSOR NAME :INITARG :NAME :INITFORM VALUE)))
(let* ((td (make-instance 'trial-data))
(slot-lst (mapcar #'slot-definition-name (class-slots (class-of td)))))
I can read the values of these slots:
(let* ((td (make-instance 'trial-data))
(slot-lst (mapcar #'slot-definition-name (class-slots (class-of td)))))
(funcall (symbol-function (nth 0 slot-lst)) td))
==> NIL
But why can I not write new values to these slots? Shouldn't my class definition of trial-data have created an accessor function for each slot?
;; Should set the first slot, a-datum's, value to 42
(let* ((td (make-instance 'trial-data))
(slot-lst (mapcar #'slot-definition-name (class-slots (class-of td)))))
(setf (funcall (symbol-function (nth 0 slot-lst)) td) 42))
==>
;Compiler warnings for "/Users/frank/Documents/NRL/Error/Patrolbot/Patrol Construction Notes & Testing.lisp" :
; In an anonymous lambda form at position 123: Undefined function (SETF FUNCALL)
> Error: Undefined function (SETF FUNCALL) called with arguments (42 #<STANDARD-GENERIC-FUNCTION A-DATUM #x302001D1C5DF> #<TRIAL-DATA #x30200200D95D>) .
> While executing: #<Anonymous Function #x30200200EB7F>, in process Listener-2(5).
The accessor is called a-datum.
The reader:
CL-USER 9 > #'a-datum
#<STANDARD-GENERIC-FUNCTION A-DATUM 406000091C>
The writer:
CL-USER 10 > #'(setf a-datum)
#<STANDARD-GENERIC-FUNCTION (SETF A-DATUM) 422000958C>
If you want to call via funcall the writer, you need to call above function.
If you have a plain form (setf (a-datum foo) 'bar)) then this needs to be resolved at macro expansion time.
The error message says that #'(setf funcall) is undefined. Thus (setf (funcall ...) ...) does not exist.
How do you get the writer function in your case?
CL-USER 11 > (fdefinition '(setf a-datum))
#<STANDARD-GENERIC-FUNCTION (SETF A-DATUM) 422000958C>
CL-USER 12 > (let ((name 'a-datum)) (fdefinition `(setf ,name)))
#<STANDARD-GENERIC-FUNCTION (SETF A-DATUM) 422000958C>
Task for you: what are the correct arguments for above function?
Rainer Joswigs's answer addresses the issue of why you can't set with the code that you have now. However, it's also important to note that there's no reason that reader, writer, or accessor name has to be the same as the slot name, so if what you've actually got is the slot name, then you should use (setf slot-value) with it. E.g.,
(defclass foo ()
((bar :accessor getbar :initform 42)))
(defparameter *foo* (make-instance 'foo))
;; neither of these work
(setf (bar *foo*) 34)
(funcall #'(setf bar) 34 *foo*)
(slot-value *foo* 'bar)
;=> 42
(setf (slot-value *foo* 'bar) 36)
;=> 26
(slot-value *foo* 'bar)
;=> 36
Related
This is probably a stupid question, but I'm walking through the PG lisp book, and I wanted to step through some example macros that he provides with actual values, for instance:
(defmacro our-let (binds &body body)
`(
(lambda ,(
mapcar #'(lambda (x) (if (consp x) (car x) x)) binds
)
,#body
)
,#(mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) binds)
)
)
I naively tried to run (trace our-let) and then (our-let ((x 1) (y 2)) (+ x y)) but I'm getting an error, can't use encapsulation to trace anonymous function #<FUNCTION (MACRO-FUNCTION OUR-LET) {22675BBB}>. Also not sure how to best put print statements into the lambdas. What's the best way to debug this macro/output how it's processing inputs?
EDIT(1): I had the incorrect formatting for macroexpand, which works.
Actually being able to trace macros is not very common in Common Lisp implementations. Compilers will typically expand the macro forms during compilation.
A few implementations support it though - which makes sense when they also support a Lisp interpreter, which runs the actual source. Among those are LispWorks and CLISP.
Here using the code from Sylwester in CLISP:
i i i i i i i ooooo o ooooooo ooooo ooooo
I I I I I I I 8 8 8 8 8 o 8 8
I \ `+' / I 8 8 8 8 8 8
\ `-+-' / 8 8 8 ooooo 8oooo
`-__|__-' 8 8 8 8 8
| 8 o 8 8 o 8 8
------+------ ooooo 8oooooo ooo8ooo ooooo 8
Welcome to GNU CLISP 2.49.93+ (2018-02-18) <http://clisp.org/>
Copyright (c) Bruno Haible, Michael Stoll 1992-1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2018
Type :h and hit Enter for context help.
[1]> (defmacro our-let ((&rest bindings) &body body)
(let ((names (mapcar #'(lambda (x) (if (consp x) (car x) x)) bindings))
(exprs (mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) bindings)))
`((lambda ,names ,#body) ,#exprs)))
OUR-LET
[2]> (trace our-let)
;; Tracing macro OUR-LET.
(OUR-LET)
[3]> (dotimes (i 3)
(our-let ((x (* i 10)))
(+ x 3)))
1. Trace: (OUR-LET ((X (* I 10))) (+ X 3))
1. Trace: OUR-LET ==> ((LAMBDA (X) (+ X 3)) (* I 10))
1. Trace: (OUR-LET ((X (* I 10))) (+ X 3))
1. Trace: OUR-LET ==> ((LAMBDA (X) (+ X 3)) (* I 10))
1. Trace: (OUR-LET ((X (* I 10))) (+ X 3))
1. Trace: OUR-LET ==> ((LAMBDA (X) (+ X 3)) (* I 10))
NIL
[4]>
How you debug it:
(macroexpand-1 '(our-let ((x 1) (y 2)) (+ x y)))
; ==> ((lambda (X Y) (+ X Y)) 1 2)
; ==> t
BTW your formatting is not good. Here is how it can look:
(defmacro our-let (binds &body body)
`((lambda ,(mapcar #'(lambda (x) (if (consp x) (car x) x)) binds)
,#body)
,#(mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) binds)))
Or I would prefer:
(defmacro our-let ((&rest bindings) &body body)
(let ((names (mapcar #'(lambda (x) (if (consp x) (car x) x)) bindings))
(exprs (mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) bindings)))
`((lambda ,names ,#body) ,#exprs)))
A nice thing about CL is that its designers thought quite hard about some things. In particular it turns out that you can trace macroexpansion portably in CL, thanks to *macroexpand-hook*. The code at the end of this answer uses it to trace macroexpansion It makes some attempt to cooperate with anything else which might be talking to *macroexpand-hook*, and to avoid recursive tracing, but it's not very well tested. There are controls for how much should be printed which have default values which are 'much less than everything'.
Here is an example of this in LispWorks:
> (macroexpand-traced-p)
nil
> (trace-macroexpand)
t
> (defun foo (x) x)
(defun foo (x) ...)
-> (dspec:def (defun foo) (dspec:install-defun 'foo # ...))
(dspec:def (defun foo) (dspec:install-defun 'foo # ...))
-> (compiler-let (#) (compiler::top-level-form-name # #))
(compiler::top-level-form-name (defun foo)
(dspec:install-defun 'foo # ...))
-> (compiler::tlf-name-binding (compiler-let #)
(dspec:install-defun 'foo # ...))
(compiler::tlf-name-binding (compiler-let #)
(dspec:install-defun 'foo # ...))
-> (compiler-let (# #) (dspec:install-defun 'foo # ...))
(dspec:location)
-> ':listener
foo
As you can see you get a lot of internal expansions which are probably not interesting. To deal with this there is support for filtering the output so you don't see macroexpansions which may not be interesting to you, of which there are a lot.
Here is a filter function which tries to only show expansions where the thing being expanded is visible in the current package:
(defun trace-macroexpand-trace-this-package-p (macro-function macro-form
environment)
(declare (ignore macro-function environment))
(and (consp macro-form)
(symbolp (first macro-form))
(let ((name (first macro-form)))
(eq (find-symbol (symbol-name name) *package*) name))))
And here is the some output for that:
> (setf *trace-macroexpand-trace-p* #'trace-macroexpand-trace-this-package-p)
(setf *trace-macroexpand-trace-p*
#'trace-macroexpand-trace-this-package-p)
-> (let* (#) (setq *trace-macroexpand-trace-p* #:|Store-Var-1102|))
#<Function trace-macroexpand-trace-this-package-p 4060000844>
> (defun foo (x) x)
(defun foo (x) ...)
-> (dspec:def (defun foo) (dspec:install-defun 'foo # ...))
foo
As you can see you only now get 'interesting' macroexpansions. Cleverer filters could be defined, of course.
Here is the code:
(eval-when (:load-toplevel :compile-toplevel :execute)
;; macroexpansion tracing really wants to be off when compiling this
;; code as exciting things may happen during the evaluation of
;; DEFVAR &c otherwise.
(when (fboundp 'trace-macroexpand)
(ignore-errors ;don't barf
(trace-macroexpand nil))))
(defvar *trace-macroexpand-print-length* 3
"The value of *PRINT-LENGTH* used when tracing macroexpansions")
(defvar *trace-macroexpand-print-level* 2
"The value of *PRINT-LEVEL* used when tracing macroexpansions")
(defvar *trace-macroexpand-trace-p* (constantly t)
"Should we trace a given macroexpansion?
If this is bound to a function that function will be called with the
same three arguments that *MACROEXPAND-HOOK* takes, and should return
true if the expansion is to be printed. Otherwise it should be true
if expansion is to be printed, false otherwise.")
(defvar *traced-macroexpand-hook*
;; the old value of *MACROEXPAND-HOOK*, used to restore it and to
;; know if we should trace. Not user-adjustable.
nil)
(defun trace-macroexpand (&optional (tracep t))
"Trace or untrace macroexpansion.
If called with no argument, or an argument which is true, ensure that
macroexpansion is on. If it was already on return NIL, otherwise
return T.
If called with an argument which is NIL then ensure macroexpansion is
not traced. If it was traced return T else return NIL."
(if tracep
(if *traced-macroexpand-hook*
nil
(let ((hook *macroexpand-hook*))
(flet ((macroexpand-hook (macro-function macro-form environment)
(if (if (functionp *trace-macroexpand-trace-p*)
(funcall *trace-macroexpand-trace-p*
macro-function macro-form environment)
*trace-macroexpand-trace-p*)
(let ((expanded-form (funcall hook macro-function
macro-form environment))
(*print-length* *trace-macroexpand-print-length*)
(*print-level* *trace-macroexpand-print-level*)
(*print-pretty* t))
(format *debug-io* "~&~S~% -> ~S~%" macro-form expanded-form)
expanded-form)
(funcall hook macro-function macro-form environment))))
(setf *traced-macroexpand-hook* hook
*macroexpand-hook* #'macroexpand-hook)
t)))
(if *traced-macroexpand-hook*
(progn
(setf *macroexpand-hook* *traced-macroexpand-hook*
*traced-macroexpand-hook* nil)
t)
nil)))
(defun macroexpand-traced-p ()
"Is macroexpansion currently traced?"
(if *traced-macroexpand-hook* t nil))
Here is one way to trace the macro that should work in any Common Lisp:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun our-let-expander (binds body)
`((lambda ,(mapcar #'(lambda (x) (if (consp x) (car x) x)) binds)
,#body)
,#(mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) binds))))
(defmacro our-let (binds &body body)
(our-let-expander binds body))
Now we just (trace our-let-expander).
In my experience, complicated macros often end up handled via expander helper functions like this anyway, for various reasons.
(One big reason is this: as soon as you have two or more syntactic interfaces to the same expansion logic, you don't want to copy and paste that logic into multiple defmacro forms, but have it in a function.)
P.S. note the reformatting of the backquote form. Do not separate opening parentheses from what follows, and have closing parentheses on lines by themselves.
I have LISP written in JavaScript (https://jcubic.github.io/lips/ with online demo where you can try it) and I have macro like this:
(define-macro (globalize symbol)
(let ((obj (--> (. lips 'env) (get symbol))))
`(begin
,#(map (lambda (key)
(print (concat key " " (function? (. obj key))))
(if (function? (. obj key))
(let* ((fname (gensym))
(args (gensym))
(code `(define (,(string->symbol key) . ,args)
(apply (. ,obj ,key) ,args))))
(print code)
code)))
;; native Object.key function call on input object
(array->list (--> Object (keys obj)))))))
In this code I use this:
(let ((obj (--> (. lips 'env) (get symbol))))
and I call this macro using:
(globalize pfs)
to create function for each static method of pfs (which is LightingFS from isomorphic-git where each function return a promise, it's like fs from node).
But it will not work for something like this:
(let ((x pfs))
(globalize x))
because lips.env is global enviroment.
So my question is this how macro should work? Should they only process input data as symbols so they never have access to object before evaluation of lisp code?
How the LISP macro that generate bunch of functions based on variable should look like. For instance in scheme if I have alist in variable and want to generate function for each key that will return a value:
input:
(define input `((foo . 10) (bar . 20)))
output:
(begin
(define (foo) 10)
(define (bar) 20))
Can I write macro that will give such output if I use (macro input)? Or the only option is (macro ((foo . 10) (bar . 20)))?
I can accept generic Scheme or Common LISP answer but please don't post define-syntax and hygienic macros from scheme, My lisp don't have them and will never have.
The problem seems to be that I want to access value at macro expansion time and it need to have the value that in runtime. And second question Is eval in this case the only option?
This works in biwascheme:
(define-macro (macro obj)
(let ((obj (eval obj)))
`(begin
,#(map (lambda (pair)
(let ((name (car pair))
(value (cdr pair)))
`(define (,name) ,value)))
obj))))
(define input `((foo . 10) (bar . 20)))
(macro input)
(foo)
;; ==> 10
(bar)
;; ==> 20
(in my lisp eval don't work like in biwascheme but that's other issue).
but this don't work, because x is not global:
(let ((x '((g . 10)))) (macro x))
Is macro with eval something you would normally do, or should them be avoided? Is there other way to generate bunch of functions based on runtime object.
In Common Lisp: creating and compiling functions at runtime.
CL-USER 20 > (defparameter *input* '((foo . 10) (bar . 20)))
*INPUT*
CL-USER 21 > (defun make-my-functions (input)
(loop for (symbol . number) in input
do (compile symbol `(lambda () ,number))))
MAKE-MY-FUNCTIONS
CL-USER 22 > (make-my-functions *input*)
NIL
CL-USER 23 > (foo)
10
CL-USER 24 > (bar)
20
From a local variable:
CL-USER 25 > (let ((input '((foo2 . 102) (bar3 . 303))))
(make-my-functions input))
NIL
CL-USER 26 > (bar3)
303
With a macro, more clumsy and limited:
CL-USER 37 > (defparameter *input* '((foo1 . 101) (bar2 . 202)))
*INPUT*
CL-USER 38 > (defmacro def-my-functions (input &optional getter)
`(progn
,#(loop for (symbol . number) in (if getter
(funcall getter input)
input)
collect `(defun ,symbol () ,number))))
DEF-MY-FUNCTIONS
CL-USER 39 > (def-my-functions *input* symbol-value)
BAR2
CL-USER 40 > (foo1)
101
I'm trying to define a macro that'll take a struct's name, a key, and the name of a hash table in the struct and define functions to access and modify the value under the key in the hash.
(defmacro make-hash-accessor (struct-name key hash)
(let ((key-accessor (gensym))
(hash-accessor (gensym)))
`(let ((,key-accessor (accessor-name ,struct-name ,key))
(,hash-accessor (accessor-name ,struct-name ,hash)))
(setf (fdefinition ,key-accessor) ; reads
(lambda (instance)
(gethash ',key
(funcall ,hash-accessor instance))))
(setf (fdefinition '(setf ,key-accessor)) ; modifies
(lambda (instance to-value)
(setf (gethash ',key
(funcall ,hash-accessor instance))
to-value))))))
;; Returns the symbol that would be the name of an accessor for a struct's slot
(defmacro accessor-name (struct-name slot)
`(intern
(concatenate 'string (symbol-name ',struct-name) "-" (symbol-name ',slot))))
To test this I have:
(defstruct tester
(hash (make-hash-table)))
(defvar too (make-tester))
(setf (gethash 'x (tester-hash too)) 3)
When I run
(make-hash-accessor tester x hash)
then
(tester-x too)
it returns 3 T, as it should, but
(setf (tester-x too) 5)
gives the error:
The function (COMMON-LISP:SETF COMMON-LISP-USER::TESTER-X) is undefined.
[Condition of type UNDEFINED-FUNCTION]
(macroexpand-1 '(make-hash-accessor tester x hash)) expands to
(LET ((#:G690 (ACCESSOR-NAME TESTER X)) (#:G691 (ACCESSOR-NAME TESTER HASH)))
(SETF (FDEFINITION #:G690)
(LAMBDA (INSTANCE) (GETHASH 'X (FUNCALL #:G691 INSTANCE))))
(SETF (FDEFINITION '(SETF #:G690))
(LAMBDA (INSTANCE TO-VALUE)
(SETF (GETHASH 'X (FUNCALL #:G691 INSTANCE)) TO-VALUE))))
T
I'm using SBCL. What am I doing wrong?
You should use defun whenever possible.
Specifically, here instead of defmacro for accessor-name and instead of (setf fdefinition) for your accessors:
(defmacro define-hash-accessor (struct-name key hash)
(flet ((concat-symbols (s1 s2)
(intern (concatenate 'string (symbol-name s1) "-" (symbol-name s2)))))
(let ((hash-key (concat-symbols struct-name key))
(get-hash (concat-symbols struct-name hash)))
`(progn
(defun ,hash-key (instance)
(gethash ',key (,get-hash instance)))
(defun (setf ,hash-key) (to-value instance)
(setf (gethash ',key (,get-hash instance)) to-value))
',hash-key))))
(defstruct tester
(hash (make-hash-table)))
(defvar too (make-tester))
(setf (gethash 'x (tester-hash too)) 3)
too
==> #S(TESTER :HASH #S(HASH-TABLE :TEST FASTHASH-EQL (X . 3)))
(define-hash-accessor tester x hash)
==> tester-x
(tester-x too)
==> 7; T
(setf (tester-x too) 5)
too
==> #S(TESTER :HASH #S(HASH-TABLE :TEST FASTHASH-EQL (X . 5)))
Note that I use a more conventional name for the macro: since it defines accessorts, it is common to name it define-... (cf. define-condition, defpackage).
make-... is usually used for functions returning objects (cf. make-package).
See also Is defun or setf preferred for creating function definitions in common lisp and why?
Remember, style is important, both in indentation and in naming variables, functions, and macros.
I want to do something like that in Common Lisp:
(defparameter *fun*
(lambda () x))
(let ((x 0))
(funcall *fun*)) ;should return 0
I want to access a local binding in a function, that is not defined, when I define the function.
If I use x as parameter, it would work, but I can't change the value of the variable:
(defparameter *fun*
(lambda (x) (setf x (+ x 1))))
(let ((x 0))
(funcall *fun* x)) ;should return 1, would return 0
How can I do what I want?
You can declare the variable special (dynamic) at both the binding site and the reference site:
(defparameter *fun*
(lambda () (declare (special x)) x))
(let ((x 0))
(declare (special x))
(funcall *fun*))
Or globally:
(defvar *x*) ;; makes *x* special
(defparameter *fun*
(lambda () *x*))
(let ((*x* 0))
(funcall *fun*))
Late edit:
A macro might serve you better in this scenario. The only lexical bindings a function can access are the ones that were present when it was created. For example, the behavior you described is given by the standard in the macro incf. Define-modify-macro is a helper for defining macros similar to incf. http://www.lispworks.com/documentation/HyperSpec/Body/m_defi_2.htm
You can define the function in the nested scope:
[2]> (defparameter *fun* (let ((x 0)) (lambda () (setf x (+ x 1)))))
*FUN*
[3]> (funcall *fun*)
1
[4]> (funcall *fun*)
2
If your function is defined outside the scope of a lexical variable, it can't access that variable, by definition of what is lexical scope. To be able to do that, it must be inside that scope.
The other way around this issue is to make the variable special, giving it dynamic extent:
[5]> (defparameter *x* 1)
*X*
[11]> (defun fun () (setf *x* (+ *x* 1)))
FUN
[12]> *x*
1
[13]> (fun)
2
[16]> *x*
2
In other words, is it possible to locally define a function in a way similar to how flet or labels does it? My final goal is to have a macro similar to labels which instead of regular functions uses instances of funcallable-standard-class and not having to use funcall. A use-case might look like the one below:
(funcallable-let ((foo func-class :initargs ...))
(foo ...))
symbol-macrolet seems to only expand when not in the head position. If I try (setf (symbol-function 'foo) (make-instance 'some-funcallable-class)) this sets it globally for this symbol an not for the scope of the enclosing let.
Here's what I could get so far (but it doesn't work because macrolet wouldn't expand in this scenario...)
(defclass func ()
((state :initarg :state :accessor state-of))
(:metaclass sb-mop:funcallable-standard-class))
(defmethod initialize-instance :after ((this func) &rest initargs)
(declare (ignore initargs))
(sb-mop:set-funcallable-instance-function
this (lambda ()
(format t "~&I am: ~s, my state is: ~s" this (state-of this)))))
(defmacro funcallable-let (bindings &body body)
(loop :for binding :in bindings
:for name := (car binding)
:for class := (cadr binding)
:for init-args := (cddr binding)
:collect `(,name (make-instance ',class ,.init-args)) :into classes
:collect `(,name (&rest args) (list 'apply '',name args)) :into macrolets
:collect name :into ignorables
:finally
(return
`(let ,classes
(declare (ignorable ,#ignorables))
(macrolet ,macrolets
,#body)))))
(defun test-funcallable-let ()
(funcallable-let ((f func :state :f-state)
(g func :state :g-state))
(f) (funcall 'g)))
This is somewhat modified Lars' Brinkoff macro:
(defmacro funcallable-let (bindings &body body)
(loop
:for binding :in bindings
:for symbol := (gensym)
:for name := (car binding)
:for class := (cadr binding)
:for init-args := (cddr binding)
:collect `(,symbol (make-instance ',class ,.init-args)) :into lets
:collect `(,name (&rest args) (apply ',symbol args)) :into flets
:collect symbol :into ignorables
:finally
(return
`(let ,lets
(declare (ignorable ,#ignorables))
(flet ,flets ,#body)))))
Which wouldn't work either.
So, we want the value of f to be the funcallable object, so that things like (setf (state-of f) new-state) work, but also a macro definition for f, so that (f 1 2 3) expands to (funcall f 1 2 3). Let's write some direct code first. First, your func definition, but with a slightly different funcallable instance function, so that we can pass some arguments in and see what they are:
(defclass func ()
((state :initarg :state :accessor state-of))
(:metaclass sb-mop:funcallable-standard-class))
(defmethod initialize-instance :after ((this func) &rest initargs)
(declare (ignore initargs))
(sb-mop:set-funcallable-instance-function
this (lambda (&rest args)
(format t "~&I am: ~s, my state is: ~s, my args were ~s" this (state-of this) args))))
Then, we can write the code that we'd want the funcallable-let to expand into. As the output shows, f in a head position ends up being a call to the funcallable instance, but f in a non head position is a variable that has the funcallable instance as a value, so you can, e.g., (setf (state-of f) new-state):
(let ((f (make-instance 'func :state 34)))
(macrolet ((f (&rest args)
`(funcall f ,#args)))
(f 1 2 3)
(setf (state-of f) 89)
(f 4 5 6)))
; I am: #<FUNC {1002A0B329}>, my state is: 34, my args were (1 2 3)
; I am: #<FUNC {1002A0B329}>, my state is: 89, my args were (4 5 6)
That seems good. Now we just need to macroify it:
(defmacro funcallable-let (bindings &body body)
`(let (,#(loop :for (name . initargs) :in bindings
:collect `(,name (make-instance 'func ,#initargs))))
(macrolet (,#(loop :for (name . initargs) :in bindings
:collect `(,name (&rest args)
`(funcall ,',name ,#args))))
,#body)))
The macroexpansion looks right:
CL-USER> (pprint (macroexpand '(funcallable-let ((f :state 34))
(f 1 2 3))))
(LET ((F (MAKE-INSTANCE 'FUNC :STATE 34)))
(MACROLET ((F (&REST ARGS)
`(FUNCALL F ,#ARGS)))
(F 1 2 3)))
And the behavior seems right (you can call with (f ...) or with (funcall f ...), and you can (setf (state-of f) ...):
CL-USER> (funcallable-let ((f :state 34))
(f 1 2 3)
(setf (state-of f) 89)
(f 4 5 6)
(setf (state-of f) 62)
(funcall f 7 8 9))
I am: #<FUNC {1002BEC389}>, my state is: 34, my args were (1 2 3)
I am: #<FUNC {1002BEC389}>, my state is: 89, my args were (4 5 6)
I am: #<FUNC {1002BEC389}>, my state is: 62, my args were (7 8 9)
NIL
I'm not sure what you are trying to do, but maybe this?
(defmacro funcallable-let (bindings &body body)
(let ((gensyms (loop repeat (length bindings) collect (gensym))))
`(let ,(loop for (name value) in bindings and g in gensyms
collect `(,g ,value))
(flet ,(loop for (name value) in bindings and g in gensyms
collect `(,name (&rest args) (apply ,g args)))
,#body))))
Sample usage:
(funcallable-let ((foo (make-instance 'some-funcallable-class :initargs ...)))
(foo ...))
For a similar problem see GENERIC-FLET and GENERIC-LABELS of CLtL2 and why it was removed in ANSI Common Lisp.
http://www.lispworks.com/documentation/HyperSpec/Issues/iss181_w.htm