I have a macro below that iterates along bits in an integer. I would like to integrate the collect capability of the loop like this:
(loop for x in '(a b c d e)
for y in '(1 2 3 4 5)
collect (list x y) )
How should I modify the macro below to accomplish the above?
(defmacro do-bits ((var x) &rest body)
"Evaluates [body] forms after binding [var] to each set bit in [x]"
(let ((k (gensym)))
`(do ((,k ,x (logand ,k (1- ,k))))
((= ,k 0))
(let ((,var (logand ,k (- ,k))))
,#body))))
here's a simple macro with-collector that should do the trick:
(defmacro with-collector ((&optional (collector-name 'collect)) &body body)
(let ((result (gensym)))
`(let ((,result (list)))
(flet ((,collector-name (arg) (push arg ,result)))
(progn ,#body)
(when ,result
(nreverse ,result)))))
it uses the name collect by default:
(with-collector ()
(collect 'a)
(collect 'b)); => (A B)
but you can use another name if you like (e.g. for nesting or resolving a symbol conflict)
(with-collector (foo)
(foo 'bar)
(foo 'baz)); => (BAR BAZ)
to integrate it with your macro, just wrap the do form:
(defmacro do-bits ((var x) &rest body)
"Evaluates [body] forms after binding [var] to each set bit in [x]"
(let ((k (gensym)))
`(with-collector ()
(do ((,k ,x (logand ,k (1- ,k))))
((= ,k 0))
(let ((,var (logand ,k (- ,k))))
,#body)))))
and collect will be available in the body:
(do-bits (x 255) (collect x))
; => (1 2 4 8 16 32 64 128)
(do-bits (x 256) (collect x))
; => (256)
Related
So i have this macro (basically a for loop):
(defmacro for ((parameter start-value end-value &optional (step 1)) &body e)
(let ((func-name (gensym))
(end (gensym)))
`(labels ((,func-name (,parameter ,end)
(if (<= ,parameter ,end)
(progn ,#e
(,func-name (+ ,parameter ,step) ,end)))))
(,func-name ,start-value ,end-value))))
And i want to test it with this:
(print (let ((j 0) (k 1))
(for (i 1 10 (incf k)) (print i))))
What i get now is:
1, 3, 6, 10, NIL.
which means that my step increments after each iteration, but i want it to increment only once in the beginning for this output:
1, 3, 5, 7, 9, NIL.
What's wrong with my macro and what should i do?
You need to compute the step value outside the loop:
CL-USER 12 > (defmacro for ((parameter start-value end-value
&optional (step 1))
&body e)
(let ((func-name (gensym))
(step-name (gensym))
(end (gensym)))
`(labels ((,func-name (,parameter ,end ,step-name)
(when (<= ,parameter ,end)
,#e
(,func-name (+ ,parameter ,step-name)
,end
,step-name))))
(,func-name ,start-value ,end-value ,step))))
FOR
CL-USER 13 > (pprint (macroexpand-1 '(for (i 1 10 (incf k)) (print i))))
(LABELS ((#:G954 (I #:G956 #:G955)
(WHEN (<= I #:G956) (PRINT I) (#:G954 (+ I #:G955) #:G956 #:G955))))
(#:G954 1 10 (INCF K)))
CL-USER 14 > (let ((j 0) (k 1))
(for (i 1 10 (incf k))
(print i)))
1
3
5
7
9
NIL
If you don't want to pass the step-value all the time, you need an outer LET binding its value.
Note: some Lisp implementations (many interpreters and some compilers) don't support TCO (tail call optimisation).
Say I have a macro like this:
(define-syntax (choose stx)
(define data (syntax->datum stx))
(define args (cadr data))
(define body (cddr data))
(define output
`(apply (case (car ,args)
,(map (lambda (choice)
`((,(car choice)) ,(cadr choice)))
body)
(else (displayln "error")))
(cdr ,args)))
(println output)
#'(void))
If I use this on something like this (there could be more options):
(choose args
("run" runsomething)
("del" delsomethingelse))
It transforms it to
(apply
(case (car args)
((("run") runsomething)
(("del") delsomethingelse))
(else (displayln "error")))
(cdr args))
Which is not valid code, because the map gave it extra parentheses. Instead I want it to give me this:
(apply
(case (car args)
(("run") runsomething)
(("del") delsomethingelse)
(else (displayln "error")))
(cdr args))
How could I do something like this?
Use unquote-splicing (aka ,#) to get rid of the list surrounding map.
Example:
(define xs '(a b c))
`(1 2 ,xs 3 4) ; => '(1 2 (a b c) 3 4)
`(1 2 ,#xs 3 4) ; => '(1 2 a b c 3 4)
However I notice that you use syntax->datum on the input stx
of the syntax transformer. That removes lexical information, which
could end up causing problems. It recommend using either syntax-case
or syntax-parse, which use pattern matching to pick out the elements
of the input syntax and templates to generate the output.
(define-syntax (choose stx)
(syntax-case stx ()
[(_choose args
(datum fun-expr)
...)
#'(apply (case (car args)
[(datum) fun-expr]
...)
(cdr args))]))
(define (run-it . xs) (list 'ran-it xs))
(define (del-it . xs) (list 'delt-it xs))
(choose (list "run" 1 2 3)
("run" run-it)
("del" del-it))
Output: '(ran-it (1 2 3))
I'm new to lisp, and have been trying to learn Common Lisp by diving in and writing some code. I've read plenty of documentation on the subject, but it's taking a while to really sink in.
I have written a couple of macros (? and ??) for performing unit tests, but I'm having some difficulty. The code is at the end of the post, to avoid cluttering the actual question.
Here is an example of usage:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3)
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
And an example of output:
[Arithmetic tests]
[Addition]
(PASS) '(= (+ 1 2) 3)'
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
Results: 3 tests passed, 0 tests failed
Now, the existing code works. Unfortunately, the (? ...) macro is ugly, verbose, resistant to change - and I'm pretty sure also badly structured. For example, do I really have to use a list to store pieces of output code and then emit the contents at the end?
I'd like to modify the macro to permit description strings (or symbols) to optionally follow each test, whereupon it would replace the test literal in the output, thus:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
Output:
[Arithmetic tests]
[Addition]
(PASS) Adding 1 and 2 results in 3
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
But unfortunately I can't find a sensible place in the macro to insert this change. Depending on where I put it, I get errors like you're not inside a backquote expression, label is not defined or body-forms is not defined. I know what these errors mean, but I can't find a way to avoid them.
Also, I'll be wanting to handle exceptions in the test, and treat that as a failure. Currently, there is no exception handling code - the test result is merely tested against nil. Again, it is not clear how I should add this functionality.
I'm thinking that maybe this macro is over-complex, due to my inexperience in writing macros; and perhaps if I simplify it, modification will be easier. I don't really want to separate it out into several smaller macros without good reason; but maybe there's a terser way to write it?
Can anyone help me out here, please?
A complete code listing follows:
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defmacro while (condition &body body)
`(loop while ,condition do (progn ,#body)))
(defun flatten (L)
"Converts a list to single level."
(if (null L)
nil
(if (atom (first L))
(cons (first L) (flatten (rest L)))
(append (flatten (first L)) (flatten (rest L))))))
(defun starts-with-p (str1 str2)
"Determine whether `str1` starts with `str2`"
(let ((p (search str2 str1)))
(and p (= 0 p))))
(defmacro pop-first-char (string)
`(with-gensyms (c)
(if (> (length ,string) 0)
(progn
(setf c (schar ,string 0))
(if (> (length ,string) 1)
(setf ,string (subseq ,string 1))
(setf ,string ""))))
c))
(defmacro pop-chars (string count)
`(with-gensyms (result)
(setf result ())
(dotimes (index ,count)
(push (pop-first-char ,string) result))
result))
(defun format-ansi-codes (text)
(let ((result ()))
(while (> (length text) 0)
(cond
((starts-with-p text "\\e")
(push (code-char #o33) result)
(pop-chars text 2)
)
((starts-with-p text "\\r")
(push (code-char 13) result)
(pop-chars text 2)
)
(t (push (pop-first-char text) result))
))
(setf result (nreverse result))
(coerce result 'string)))
(defun kv-lookup (values key)
"Like getf, but works with 'keys as well as :keys, in both the list and the supplied key"
(setf key (if (typep key 'cons) (nth 1 key) key))
(while values
(let ((k (pop values)) (v (pop values)))
(setf k (if (typep k 'cons) (nth 1 k) k))
(if (eql (symbol-name key) (symbol-name k))
(return v)))))
(defun make-ansi-escape (ansi-name)
(let ((ansi-codes '( :normal "\\e[00m" :white "\\e[1;37m" :light-grey "\\e[0;37m" :dark-grey "\\e[1;30m"
:red "\\e[0;31m" :light-red "\\e[1;31m" :green "\\e[0;32m" :blue "\\e[1;34m" :dark-blue "\\e[1;34m"
:cyan "\\e[1;36m" :magenta "\\e[1;35m" :yellow "\\e[0;33m"
:bg-dark-grey "\\e[100m"
:bold "\\e[1m" :underline "\\e[4m"
:start-of-line "\\r" :clear-line "\\e[2K" :move-up "\\e[1A")))
(format-ansi-codes (kv-lookup ansi-codes ansi-name))
))
(defun format-ansi-escaped-arg (out-stream arg)
(cond
((typep arg 'symbol) (format out-stream "~a" (make-ansi-escape arg)))
((typep arg 'string) (format out-stream arg))
(t (format out-stream "~a" arg))
))
(defun format-ansi-escaped (out-stream &rest args)
(while args
(let ((arg (pop args)))
(if (typep arg 'list)
(let ((first-arg (eval (first arg))))
(format out-stream first-arg (second arg))
)
(format-ansi-escaped-arg out-stream arg)
))
))
(defmacro while-pop ((var sequence &optional result-form) &rest forms)
(with-gensyms (seq)
`(let (,var)
(progn
(do () ((not ,sequence))
(setf ,var (pop ,sequence))
(progn ,#forms))
,result-form))))
(defun report-start (form)
(format t "( ) '~a'~%" form))
(defun report-result (result form)
(format-ansi-escaped t "(" (if result :green :red) `("~:[FAIL~;PASS~]" ,result) :normal `(") '~a'~%" ,form))
result)
(defmacro ? (name &body body-forms)
"Run any number of test forms, optionally nested within further (?) calls, and print the results of each test"
(with-gensyms (result indent indent-string)
(if (not body-forms)
:empty
(progn
(setf result () indent 0 indent-string " ")
(cond
((typep (first body-forms) 'integer)
(setf indent (pop body-forms))))
`(progn
(format t "~v#{~A~:*~}" ,indent ,indent-string)
(format-ansi-escaped t "[" :white ,name :normal "]~%")
(with-gensyms (test-results)
(setf test-results ())
,(while-pop (body-form body-forms `(progn ,#(nreverse result)))
(cond
( (EQL (first body-form) '?)
(push `(progn
(setf test-results (append test-results (? ',(nth 1 body-form) ,(1+ indent) ,#(nthcdr 2 body-form))))
(format t "~%")
test-results
) result)
)
(t
(push `(progn
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(report-start ',body-form)
(with-gensyms (result label)
(setf result ,body-form)
(format-ansi-escaped t :move-up :start-of-line :clear-line)
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(push (report-result result ',body-form) test-results)
test-results
)) result))))))))))
(defun ?? (&rest results)
"Run any number of tests, and print a summary afterward"
(setf results (flatten results))
(format-ansi-escaped t "~&" :white "Results: " :green `("~a test~:p passed" ,(count t results)) :normal ", "
(if (find NIL results) :red :normal) `("~a test~:p failed" ,(count NIL results))
:yellow `("~[~:;, ~:*~a test~:p not run~]" ,(count :skip results))
:brown `("~[~:;, ~:*~a empty test group~:p skipped~]" ,(count :empty results))
:normal "~%"))
For my part, the ? macro is rather technical and it's hard to follow the logic behind the formatting functions. So instead of tracking errors I'd like to suggest my own attempt, perhaps it'll be of use.
I think that actually your ?? doesn't want to evaluate anything, but rather to treat its body as individual tests or sections. If the body includes a list starting with ?, this list represents a section; other elements are test forms optionally followed by descriptions. So in my implementation ?? will be a macro, and ? will be just a symbol.
I start with wishful thinking. I suppose I can create individual tests using a function make-test-item and test sections using a function make-test-section (their implementation is unimportant for now), that I can display them using an auxiliary function display-test and compute results using the function results, which returns two values: the total number of tests and the number of passed ones. Then I'd like the code
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) 4))
(? "Subtraction"
(= (- 1 2) 1)))
(= (sin 0) 0) "Sine of 0 equals 0")
to expand into something like
(let ((tests (list (make-test-section :header "Arithmetic tests"
:items (list (make-test-section :header "Addition"
:items (list (make-test-item :form '(= (+ 1 2) 3)
:description "Adding 1 and 2 results in 3"
:passp (= (+ 1 2) 3))
(make-test-item :form '(= (+ 1 2 3) 6)
:passp (= (+ 1 2 3) 6))
(make-test-item :form '(= (+ -1 -3) 4)
:passp (= (+ -1 -3) 4))))
(make-test-section :header "Subtraction"
:items (list (make-test-item :form '(= (- 1 2) 1)
:passp (= (- 1 2) 1))))))
(make-test-item :form '(= (sin 0) 0)
:passp (= (sin 0) 0)
:description "Sine of 0 equals 0"))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t)))
Here a list of tests is created; then we traverse it printing each test (0 denotes the zero level of indentation and t is as in format) and keeping track of the results, finally displaying the total results. I don't think explicit eval is needed here.
It may not be the most exquisite piece of code ever, but it seems manageable. I supply missing definitions below, they are rather trivial (and can be improved) and have nothing to do with macros.
Now we pass on to the macros. Consider both pieces of code as data, then we want a list processing function which would turn the first one into the second. A few auxiliary functions would come in handy.
The major task is to parse the body of ?? and generate the list of test to go inside the let.
(defun test-item-form (form description)
`(make-test-item :form ',form :description ,description :passp ,form))
(defun test-section-form (header items)
`(make-test-section :header ,header :items (list ,#items)))
(defun parse-test (forms)
(let (new-forms)
(loop
(when (null forms)
(return (nreverse new-forms)))
(let ((f (pop forms)))
(cond ((and (listp f) (eq (first f) '?))
(push (test-section-form (second f) (parse-test (nthcdr 2 f))) new-forms))
((stringp (first forms))
(push (test-item-form f (pop forms)) new-forms))
(t (push (test-item-form f nil) new-forms)))))))
Here parse-test essentially absorbs the syntax of ??. Each iteration consumes one or two forms and collects corresponding make-... forms. The functions can be easily tested in REPL (and, of course, I did test them while writing).
Now the macro becomes quite simple:
(defmacro ?? (&body body)
`(let ((tests (list ,#(parse-test body))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t))))
It captures a few symbols, both in the variable name space and in the function one (the expansion may contain make-test-item and make-test-section). A clean solution with gensyms would be cumbersome, so I'd suggest just moving all the definitions in a separate package and exporting only ?? and ?.
For completeness, here is an implementation of the test API. Actually, it's what I started coding with and proceeded until I made sure the big let-form works; then I passed on to the macro part. This implementation is fairly sloppy; in particular, it doesn't support terminal colours and display-test can't even output a section into a string.
(defstruct test-item form description passp)
(defstruct test-section header items)
(defun results (test)
(etypecase test
(test-item (if (test-item-passp test)
(values 1 1)
(values 1 0)))
(test-section (let ((items-count 0)
(passed-count 0))
(dolist (i (test-section-items test) (values items-count passed-count))
(multiple-value-bind (i p) (results i)
(incf items-count i)
(incf passed-count p)))))))
(defparameter *test-indent* 2)
(defun display-test-item (i level stream)
(format stream "~V,0T~:[(FAIL)~;(PASS)~] ~:['~S'~;~:*~A~]~%"
(* level *test-indent*)
(test-item-passp i)
(test-item-description i)
(test-item-form i)))
(defun display-test-section-header (s level stream)
(format stream "~V,0T[~A]~%"
(* level *test-indent*)
(test-section-header s)))
(defun display-test (test level stream)
(etypecase test
(test-item (display-test-item test level stream))
(test-section
(display-test-section-header test level stream)
(dolist (i (test-section-items test))
(display-test i (1+ level) stream)))))
(defun display-result (total passed stream)
(format stream "Results: ~D test~:P passed, ~D test~:P failed.~%" passed (- total passed)))
All the code is licenced under WTFPL.
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
The problem with flet is that the functions bound therein must be defined inline. In other words, there's no way to do this:
(new-flet ((a (lambda (f x)
(funcall f (* x 2))))
(b (function-generator)))
(a #'b 10))
I considered defining such a macro myself, but the problem is that flet seems to be the only way to set local function values. symbol-function always gets the global definition only, and function can't be used with setf. Anyone have an idea how this can be done fairly cleanly, if at all?
You can easily build a trampoline
(defun function-generator (x)
(lambda (y) (* x y)))
(let ((fg (function-generator 42)))
(flet ((a (f x) (funcall f (* x 2)))
(b (x) (funcall fg x)))
(a #'b 10)))
A macro implementation of new-flet with this approach is
(defmacro new-flet (bindings &body body)
(let ((let-bindings (list))
(flet-bindings (list))
(args (gensym)))
(dolist (binding bindings)
(let ((name (gensym)))
(push `(,name ,(second binding))
let-bindings)
(push `(,(first binding) (&rest ,args)
(apply ,name ,args))
flet-bindings)))
`(let ,(nreverse let-bindings)
(flet ,(nreverse flet-bindings)
,#body))))
that expands in your example case as
(macroexpand-1 '(new-flet ((a (lambda (f x) (funcall f (* x 2))))
(b (function-generator)))
(a #'b 10)))
==> (LET ((#:G605 (LAMBDA (F X)
(FUNCALL F (* X 2))))
(#:G606 (FUNCTION-GENERATOR)))
(FLET ((A (&REST #:G604)
(APPLY #:G605 #:G604))
(B (&REST #:G604)
(APPLY #:G606 #:G604)))
(A #'B 10)))
Is
(let* ((a (lambda (f x) (funcall f (* x 2))))
(b (function-generator)))
(funcall a b 10))
a fairly clean solution to your problem?
How about binding the variables with let, so that they're setfable, and then using an flet as the body of the let so that they're funcallable and (function …)-able, too. E.g., where I've given a silly little function instead of (generate-function):
(let ((a (lambda (f x)
(funcall f (* x 2))))
(b (lambda (&rest args)
(print (list* 'print-from-b args)))))
(flet ((a (&rest args)
(apply a args))
(b (&rest args)
(apply b args)))
(a #'b 10)))
We can wrap this up in a macro relatively easily:
(defmacro let/flet (bindings &body body)
(let ((args (gensym (string '#:args-))))
`(let ,bindings
(flet ,(loop :for (name nil) :in bindings
:collect `(,name (&rest ,args) (apply ,name ,args)))
,#body))))
Now
(let/flet ((a (lambda (f x)
(funcall f (* x 2))))
(b (lambda (&rest args)
(print (list* 'print-from-b args)))))
(a #'b 10))
expands into the first block of code. Note that you can also use (a b 10) in the body as well, since the binding of b is the same as the value of #'b. You can use setf on the variable as well:
(let/flet ((a (lambda (x)
(print (list 'from-a x)))))
(a 23)
(setf a (lambda (x)
(print (list 'from-new-a x x))))
(a 23))
prints
(FROM-A 23)
(FROM-NEW-A 23 23)
If anyone's interested in a labels equivalent, here it is:
(defmacro my-labels ((&rest definitions) &rest body)
(let ((gensyms (loop for d in definitions collect (gensym)))
(names (loop for d in definitions collect (car d)))
(fdefs (loop for f in definitions collect (cadr f)))
(args (gensym)))
`(let (,#(loop for g in gensyms collect (list g)))
(labels (,#(loop for g in gensyms for n in names
collect `(,n (&rest ,args) (apply ,g ,args))))
,#(loop for g in gensyms for f in fdefs
collect `(setf ,g ,f))
,#body))))
This is sort of like Scheme's letrec.