How to achieve something like this?
(defmacro mood (x)
(if (equal (symbol-name x) "t")
`(defun happy ()
(message "Happy"))
`(defun sad ()
(message "Sad")))
)
My aim is to create different function base on argument.
Is there any problem doing so?
Edit 2: You're right -- for cases in which the code being evaluated at expansion-time is entirely dependent on the values of the (unevaluated) macro arguments, I believe it is safe for the macro's returned form to be generated conditionally, based upon those arguments.
You just need to be aware that any behaviour which is conditional upon dynamic values needs to be dealt with as a part of the expanded form.
(e.g. if the macro argument were a variable, and you were testing the value of the variable in your condition, it would be unsafe for that test to occur at expansion time, as that value is liable to vary between the macro's expansion time, and the time(s) that the expanded code is evaluated.)
So the specific example in your question is indeed safe as-is, and therefore my variations (below) are not actually necessary in this case. However expansion-time evaluations are certainly something you will want to be cautious about in general.
Initial answer follows...
Macros are expanded at compile time. (Or in recent versions of Emacs, should no byte-compiled version of the library be available, they will usually be compiled "eagerly" at load time).
In these scenarios, any code which is not a part of the form returned by the macro will be evaluated at most once per session, but quite likely just once ever for a given expansion of the code (whereas the expanded code might then be called numerous times).
If you need your expanded code to act conditionally at run-time, the conditions must be a part of the form returned by the macro.
Edit: For example, I imagine you actually wanted to write something more like:
(defmacro mood (x)
`(if (equal (symbol-name ,x) "t")
(defun happy ()
(message "Happy"))
(defun sad ()
(message "Sad"))))
Although you would (almost) never want to compare symbols by comparing their symbol-name. You've already made the assumption that the macro argument will evaluate to a symbol, so just compare the symbols directly with eq:
(defmacro mood (x)
`(if (eq ,x t)
(defun happy ()
(message "Happy"))
(defun sad ()
(message "Sad"))))
Then for example, (mood 'foo) expands to (courtesy of M-x pp-macroexpand-last-sexp):
(if
(eq 'foo t)
(defun happy nil
(message "Happy"))
(defun sad nil
(message "Sad")))
There is no problem defining it. You code, actually, almost works:
(defmacro mood (x)
(if (equal x t)
`(defun happy ()
(message "Happy"))
`(defun sad ()
(message "Sad"))))
Since if is outside of back-quotes, we can examine the value of x directly. Expanding this definition with different arguments shows that different functions are defined:
> (macroexpand '(mood t))
(defalias (quote happy) (function (lambda nil (message "Happy"))))
> (macroexpand '(mood nil))
(defalias (quote sad) (function (lambda nil (message "Sad"))))
Related
Short version:
I want to change the #+ and #- reader macros to apply to all immediately subsequent tokens starting with ##, in addition to the following token. Therefore, the following code...
#+somefeature
##someattribute1
##someattribute2
(defun ...)
...would, in the absence of somefeature, result in no code.
Long version:
I have written my own readtable-macros which apply transformations to subsequent code. For example:
##traced
(defun ...)
This yields a function that writes its arguments and return values to a file, for debugging.
This fails, however, when used in conjunction with the #+ reader macro:
#+somefeature
##traced
(defun ...)
In the absence of somefeature, the function continues to be defined, albeit without the ##traced modification. This is obviously not the desired outcome.
One possible solution would be to use progn, as follows:
#+somefeature
(progn
##traced
(defun ...))
But that's kind of ugly.
I would like to modify the #+ and #- reader macros, such that they may consume more than one token. Something like this:
(defun conditional-syntax-reader (stream subchar arg)
; If the conditional fails, consume subsequent tokens while they
; start with ##, then consume the next token.
)
(setf *readtable* (copy-readtable))
(set-dispatch-macro-character #\# #\+ #'conditional-syntax-reader)
(set-dispatch-macro-character #\# #\- #'conditional-syntax-reader)
The problem is, I don't know how to "delegate" to the original reader macros; and I don't understand enough about how they were implemented to re-implement them myself in their entirety.
A naive approach would be:
(defun consume-tokens-recursively (stream)
(let ((token (read stream t nil t)))
(when (string= "##" (subseq (symbol-string token) 0 2))
(consume-tokens-recursively stream)))) ; recurse
(defun conditional-syntax-reader (stream subchar arg)
(unless (member (read stream t nil t) *features*)
(consume-tokens-recursively stream)))
However, I'm given to believe that this wouldn't be sufficient:
The #+ syntax operates by first reading the feature specification and then skipping over the form if the feature is false. This skipping of a form is a bit tricky because of the possibility of user-defined macro characters and side effects caused by the #. and #, constructions. It is accomplished by binding the variable read-suppress to a non-nil value and then calling the read function.
This seems to imply that I can just let ((*read-suppress* t)) when using read to solve the issue. Is that right?
EDIT 1
Upon further analysis, it seems the problem is caused by not knowing how many tokens to consume. Consider the following attributes:
##export expects one argument: the (defun ...) to export.
##traced expects two arguments: the debug level and the (defun ...) to trace.
Example:
#+somefeature
##export
##traced 3
(defun ...)
It turns out that #+ and #- are capable of suppressing all these tokens; but there is a huge problem!
When under a suppressing #+ or #-, (read) returns NIL!
Example:
(defun annotation-syntax-reader (stream subchar arg)
(case (read stream t nil t)
('export
(let ((defun-form (read stream t nil t)))))
; do something
('traced
(let* ((debug-level (read stream t nil t))
(defun-form (read stream t nil t)))))))
; do something
(setf *readtable* (copy-readtable))
(set-dispatch-macro-character #\# #\# #'annotation-syntax-reader)
#+(or) ##traced 3 (defun ...)
The ##traced token is being suppressed by the #+. In this situation, all the (read) calls in (annotation-syntax-reader) consume real tokens but return NIL!
Therefore, the traced token is consumed, but the case fails. No additional tokens are thus consumed; and control leaves the scope of the #+.
The (defun ...) clause is executed as normal, and the function comes into being. Clearly not the desired outcome.
The standard readtable
Changing the macros for #+ and #- is a bit excessive solution I think, but in any case remember to not actually change the standard readtable (as you did, but its important to repeat in the answer)
The consequences are undefined if an attempt is made to modify the standard readtable. To achieve the effect of altering or extending standard syntax, a copy of the standard readtable can be created; see the function copy-readtable.
§2.1.1.2 The Standard Readtable
Now, maybe I'm missing something (please give us a hint about how your reader macro is defined if so), but I think it is possible to avoid that and write your custom macros in a way that works for your use case.
Reader macro
Let's define a simple macro as follows:
CL-USER> (defun my-reader (stream char)
(declare (ignore char))
(let ((name (read stream)
(form (read stream))
(unless *read-suppress*
`(with-decoration ,name ,form)))
MY-READER
[NB: This was edited to take into account *read-suppress*: the code always read two forms, but returns nil in case it is being ignored. In the comments you say that you may need to read an indefinite number of forms based on the name of the decoration, but with *read-suppress* the recursive calls to read return nil for symbols, so you don't know which decoration is being applied. In that case it might be better to wrap some arguments in a literal list, or parse the stream manually (read-char, etc.). Also, since you are using a dispatching macro, maybe you can add a numerical argument if you want the decoration to be applied to more than one form (#2#inline), but that could be a bad idea when later the decorated code is being modified.]
Here the reader does a minimal job, namely build a form that is intended to be macroexpanded later. I don't even need to define with-decoration for now, as I'm interested in the read step. The intent is to read the next token (presumably a symbol that indicates what decoration is being applied, and a form to decorate).
I'm binding this macro to a unused character:
CL-USER> (set-macro-character #\§ 'my-reader)
T
Here when I test the macro it wraps the following form:
CL-USER> (read-from-string "§test (defun)")
(WITH-DECORATION TEST (DEFUN))
13 (4 bits, #xD, #o15, #b1101)
And here it works with a preceding QUOTE too, the apostrophe reader grabs the next form, which recursively reads two forms:
CL-USER> '§test (defun)
(WITH-DECORATION TEST (DEFUN))
Likewise, a conditional reader macro will ignore all the next lines:
CL-USER> #+(or) t
; No values
CL-USER> #+(or) §test (defun)
; No values
CL-USER> #+(or) §one §two §three (defun)
; No values
Decoration macro
If you use this syntax, you'll have nested decorated forms:
CL-USER> '§one §two (defun test ())
(WITH-DECORATION ONE (WITH-DECORATION TWO (DEFUN TEST ())))
With respect to defun in toplevel positions, you can arrange for your macros to unwrap the nesting (not completely tested, there might be bugs):
(defun unwrap-decorations (form stack)
(etypecase form
(cons (destructuring-bind (head . tail) form
(case head
(with-decoration (destructuring-bind (token form) tail
(unwrap-decorations form (cons token stack))))
(t `(with-decorations ,(reverse stack) ,form)))))))
CL-USER> (unwrap-decorations ** nil)
(WITH-DECORATIONS (ONE TWO) (DEFUN TEST ()))
And in turn, with-decorations might know about DEFUN forms and how to annotate them as necessary.
For the moment, our original macro is only the following (it needs more error checking):
(defmacro with-decoration (&whole whole &rest args)
(unwrap-decorations whole nil))
For the sake of our example, let's define a generic annotation mechanism:
CL-USER> (defgeneric expand-decoration (type name rest))
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::EXPAND-DECORATION (0)>
It is used in with-decorations to dispatch on an appropriate expander for each decoration. Keep in mind that all the efforts here are to keep defun in a top-level positions (under a progn), a recursive annotation would let evaluation happens (in the case of defun, it would result in the name of the function being defined), and the annotation could be done on the result.
The main macro is then here, with a kind of fold (reduce) mechanism where the forms are decorated using the resulting expansion so far. This allows for expanders to place code before or after the main form (or do other fancy things):
(defmacro with-decorations ((&rest decorations) form)
(etypecase form
(cons (destructuring-bind (head . tail) form
(ecase head
(defun (destructuring-bind (name args . body) tail
`(progn
,#(loop
for b = `((defun ,name ,args ,#body)) then forms
for d in decorations
for forms = (expand-decoration d name b)
finally (return forms))))))))))
(nb. here above we only care about defun but the loop should probably be done outside of the dispatching thing, along with a way to indicate to expander methods that a function is being expanded; well, it could be better)
Say, for example, you want to declare a function as inline, then the declaration must happen before (so that the compiler can know the source code must be kept):
(defmethod expand-decoration ((_ (eql 'inline)) name rest)
`((declaim (inline ,name)) ,#rest))
Likewise, if you want to export the name of the function being defined, you can export it after the function is defined (order is not really important here):
(defmethod expand-decoration ((_ (eql 'export)) name rest)
`(,#rest (export ',name)))
The resulting code allows you to have a single (progn ...) form with a defun in toplevel position:
CL-USER> (macroexpand '§inline §export (defun my-test-fn () "hello"))
(PROGN
(DECLAIM (INLINE MY-TEST-FN))
(DEFUN MY-TEST-FN () "hello")
(EXPORT 'MY-TEST-FN))
I'm trying to create something similar to with-eval-after-load except that the body evaluates after all features have been provided. Additionally, the feature list must be provided at runtime.
For example, I want something like
(setq feature-list '(a b))
(something feature-list (message "a and b both provided"))
where this performs functionality equivalent to
(with-eval-after-load 'a
(with-eval-after-load 'b
(message "a and b both provided")))
Providing the list at runtime seems to be the tricky part. Without that requirement I could write a macro:
(defmacro eval-after-load-all (features body)
(if (null features)
body
`(with-eval-after-load (quote ,(car features))
(eval-after-load-all ,(cdr features) ,body))))
and pass the list with:
(eval-after-load-all (a b) (message "a and b both provided"))
But passing it feature-list will cause it to use the literal characters "feature-list".
I've tried defining a recursive function:
(defun eval-after-load-all (features body)
(if (null features)
body
(with-eval-after-load (car features)
(eval-after-load-all (cdr features) body))))
But when I evaluate
(eval-after-load-all feature-list (message "a and b both provided"))
(provide 'a)
;; (provide 'b)
It triggers an error at the (provide 'a) call complaining about void-variable body in the recursive call step (i.e. last expression in the function). This scope confuses me. Why is body void here?
I also tried to wrap the macro in a function so that I could pass it the evaluated arguments:
(defun macro-wrapper (features body)
(eval-after-load-all features body))
but this complains at function definition that features is not a list: wrong-type-argument listp features.
You may not use the symbol features as an argument since that is (I cite the doc of features):
A list of symbols which are the features of the executing Emacs.
Used by featurep and require, and altered by provide.
The following code for eval-after-load-all works as expected. It is derived from your recursive function definition.
I added the evaluation of the form as function or as expression with funcall or eval, respectively, I used the backquote for the lambda, and I introduced the quoting for the list and the expression in the generated lambda expression.
(defun eval-after-load-all (my-features form)
"Run FORM after all MY-FEATURES are loaded.
See `eval-after-load' for the possible formats of FORM."
(if (null my-features)
(if (functionp form)
(funcall form)
(eval form))
(eval-after-load (car my-features)
`(lambda ()
(eval-after-load-all
(quote ,(cdr my-features))
(quote ,form))))))
I am trying to make a list of callback functions, which could look like this:
(("command1" . 'callback1)
("command2" . 'callback2)
etc)
I'd like it if I could could do something like:
(define-callback callback1 "command1" args
(whatever the function does))
Rather than
(defun callback1 (args)
(whatever the function does))
(add-to-list 'callback-info ("command1" . 'callback1))
Is there a convenient way of doing this, e.g., with macros?
This is a good example of a place where it's nice to use a two-layered approach, with an explicit function-based layer, and then a prettier macro layer on top of that.
Note the following assumes Common Lisp: it looks just possible from your question that you are asking about elisp, in which case something like this can be made to work but it's all much more painful.
First of all, we'll keep callbacks in an alist called *callbacks*:
(defvar *callbacks* '())
Here's a function which clears the alist of callbacks
(defun initialize-callbacks ()
(setf *callbacks* '())
(values)
Here is the function that installs a callback. It does this by searching the list to see if there is a callback with the given name, and if there is then replacing it, and otherwise installing a new one. Like all the functions in the functional layer lets us specify the test function which will let us know if two callback names are the same: by default this is #'eql which will work for symbols and numbers, but not for strings. Symbols are probably a better choice for the names of callbacks than strings, but we'll cope with that below.
(defun install-callback (name function &key (test #'eql))
(let ((found (assoc name *callbacks* :test test)))
(if found
(setf (cdr found) function)
(push (cons name function) *callbacks*)))
name)
Here is a function to find a callback, returning the function object, or nil if there is no callback with that name.
(defun find-callback (name &key (test #'eql))
(cdr (assoc name *callbacks* :test test)))
And a function to remove a named callback. This doesn't tell you if it did anything: perhaps it should.
(defun remove-callback (name &key (test #'eql))
(setf *callbacks* (delete name *callbacks* :key #'car :test test))
name)
Now comes the macro layer. The syntax of this is going to be (define-callback name arguments ...), so it looks a bit like a function definition.
There are three things to know about this macro.
It is a bit clever: because you can know at macro-expansion time what sort of thing the name of the callback is, you can decide then and there what test to use when installing the callback, and it does this. If the name is a symbol it also wraps a block named by the symbol around the body of the function definition, so it smells a bit more like a function defined by defun: in particular you can use return-from in the body. It does not do this if the name is not a symbol.
It is not quite clever enough: in particular it does not deal with docstrings in any useful way (it ought to pull them out of the block I think). I am not sure this matters.
The switch to decide the test uses expressions like '#'eql which reads as (quote (function eql)): that is to avoid wiring in functions into the expansion because functions are not externalisable objects in CL. However I am not sure I have got this right: I think what is there is safe but it may not be needed.
So, here it is
(defmacro define-callback (name arguments &body body)
`(install-callback ',name
,(if (symbolp name)
`(lambda ,arguments
(block ,name
,#body))
`(lambda ,arguments
,#body))
:test ,(typecase name
(string '#'string=)
(symbol '#'eql)
(number '#'=)
(t '#'equal))))
And finally here are two different callbacks being defined:
(define-callback "foo" (x)
(+ x 3))
(define-callback foo (x)
(return-from foo (+ x 1)))
These lists are called assoc lists in Lisp.
CL-USER 120 > (defvar *foo* '(("c1" . c1) ("c2" . c2)))
*FOO*
CL-USER 121 > (setf *foo* (acons "c0" `c1 *foo*))
(("c0" . C1) ("c1" . C1) ("c2" . C2))
CL-USER 122 > (assoc "c1" *foo* :test #'equal)
("c1" . C1)
You can write macros for that, but why? Macros are advanced Lisp and you might want to get the basics right, first.
Some issues with you example you might want to check out:
what are assoc lists?
what are useful key types in assoc lists?
why you don't need to quote symbols in data lists
variables are not quoted
data lists need to be quoted
You can just as easy create such lists for callbacks without macros. We can imagine a function create-callback, which would be used like this:
(create-callback 'callback1 "command1"
(lambda (arg)
(whatever the function does)))
Now, why would you use a macro instead of a plain function?
In the end, assisted by the responders above, I got it down to something like:
(defmacro mk-make-command (name &rest body)
(let ((func-sym (intern (format "mk-cmd-%s" name))))
(mk-register-command name func-sym)
`(defun ,func-sym (args &rest rest)
(progn
,#body))))
I am trying to emulate the single namespace of scheme within common lisp, with a macro (based on Doug Hoyte's) that expands to a lambda, where every use of an f! symbol (similar to Doug Hoyte's o! and g! symbols) in the function position expands to the same expression, but with funcall added in the function position of each invocation. For example:
(fplambda (f!z x) (f!z x x))
would expand to:
(LAMBDA (F!Z X) (FUNCALL F!Z X X))
The macro currently looks like this:
(defmacro fplambda (parms &body body)
(let ((syms (remove-duplicates
(remove-if-not #'f!-symbol-p
(flatten body)))))
`(lambda ,parms
(macrolet ,(mapcar
(lambda (f)
`(,f (&rest parmlist) `(funcall ,',f ',#parmlist)))
syms))
,#body)))
but given the above input, it expands (as far as I can see) to this:
(LAMBDA (F!F X)
(MACROLET ((F!F (&REST PARMLIST) `(FUNCALL ,'F!F ',#PARMLIST))))
(F!F X X))
In the macrolet definition, F!F should not be quoted or unquoted, and parmlist should just be unquoted. What is going on?
Thanks in advance!
Your definition is mostly right. You just made two pretty simple mistakes. The first one being a mismatched paren. The macrolet does not include the body (in the output the macrolet and the body are at the same level of indentation).
As for the nested backquote, the only mistake is the quote before parmlist. Other than that everything else is correct. The comma and quote before F!F is actually correct. From the hyperspec:
"An implementation is free to interpret a backquoted form F1 as any form F2 that, when evaluated, will produce a result that is the same under equal as the result implied by the above definition". Since the inner backquote has not been expanded yet, it does not have to be free of quotes and unquotes. The expression `(,'x) is actually the same as `(x).
Nested backquotes are notoriously complicated. What is probably the easiest way to understand them is to read Steele's explanation of them.
Edit:
The answer to your question about whether it is possible to use a fplambda expression in the function position is no. From the part of the hyperspec that deals with the evaluation of code: "If the car of the compound form is not a symbol, then that car must be a lambda expression, in which case the compound form is a lambda form.". Since the car of the form, (fplambda ...), is not a lambda expression, your code is no longer valid Common Lisp code.
There is a workaround to this that I figured out, but it's kind of ugly. You can define a reader macro that will allow you to write something like ([fplambda ...] ...) and have it read as
((LAMBDA (&REST #:G1030) (APPLY (FPLAMBDA ...) #:G1030)) ...)
which would do what you want. Here is code that will allow you to do that:
(set-macro-character #\[ 'bracket-reader)
(set-macro-character #\] (get-macro-character #\)))
(defun bracket-reader (stream char)
"Read in a bracket."
(declare (ignore char))
(let ((gargs (gensym)))
`(lambda (&rest ,gargs)
(apply ,(read-delimited-list #\] stream t)
,gargs))))
The only other solution I can think of would be to use some sort of code walker (I can't help you there).
I am working on a genetic programming hobby project.
I have a function/macro setup that, when evaluated in a setq/setf form, will generate a list that will look something like this.
(setq trees (make-trees 2))
==> (+ x (abs x))
Then it will get bound out to a lambda function #<FUNCTION :LAMBDA (X) ... > via strategic use of functions/macros
However, I want to get a bit more effective with this than manually assigning to variables, so I wrote something like this:
(setq sample
(let* ((trees (make-trees 2))
(tree-bindings (bind-trees trees))
(evaluated-trees (eval-fitness tree-bindings))))
(list (trees tree-bindings evaluated-trees)))
However, I get EVAL: trees has no value when I place this in a let form. My suspicion is that the macro expansions don't get fully performed in a LET as compared to a SETF, but that doesn't make sense to me.
What is the cause of this issue?
--- edit: yanked my code and put the whole file in a pastebin ---
Supposing that I decide that a setq isn't going to do it for me and I write a simple function to do it:
(defun generate-sample ()
(let ((twiggs (make-trees 2)))
(let ((tree-bindings (bind-trees twiggs)))
(let ((evaluated-trees (eval-fitness tree-bindings)))
(list twiggs tree-bindings evaluated-trees)))))
This yields an explosion of ...help file error messages (??!?)... and "eval: variable twiggs has no value", which stems from the bind-trees definition on SLIME inspection.
I am reasonably sure that I've completely hosed my macros. http://pastebin.org/673619
(Setq make-trees 2) sets the value of the variable make-trees to 2, then returns 2.
I do not see a reason for a macro in what you describe. Is it true that your make-trees creates a single random tree, which can be interpreted as a program? Just define this as a function with defun. I am thinking of something like this:
(defun make-tree (node-number)
(if (= node-number 1)
(make-leaf)
(cons (get-random-operator)
(mapcar #'make-tree
(random-partition (- node-number 1))))))
Let and setq do totally different things. Setq assigns a value to an existing variable, while let creates a new lexical scope with a number of lexical bindings.
I think that you should present more of your code; currently, your question does not make a lot of sense.
Update:
I will fix your snippet's indentation to make things clearer:
(setq sample
(let* ((trees (make-trees 2))
(tree-bindings (bind-trees trees))
(evaluated-trees (eval-fitness tree-bindings))))
(list (trees tree-bindings evaluated-trees)))
Now, as written before, let* establishes lexical bindings. These
are only in scope within its body:
(setq sample
(let* ((trees (make-trees 2))
(tree-bindings (bind-trees trees))
(evaluated-trees (eval-fitness tree-bindings)))
;; here trees, tree-bindings, and evaluated-trees are bound
) ; end of let* body
;; here trees, tree-bindings, and evaluated trees are not in scope anymore
(list (trees tree-bindings evaluated-trees)))
That last line is spurious, too. If those names were bound, it would
return a list of one element, which would be the result of evaluating
the function trees with tree-bindings and evaluated-trees as
arguments.
You might get what you want like this:
(setq sample
(let* ((trees (make-trees 2))
(tree-bindings (bind-trees trees))
(evaluated-trees (eval-fitness tree-bindings)))
(list trees tree-bindings evaluated-trees)))
Another update:
The purpose of macros is to eliminate repeated code when that elimination is not possible with functions. One frequent application is when dealing with places, and you also need them to define new control constructs. As long as you do not see that something cannot work as a function, do not use a macro for it.
Here is some code that might help you:
(defun make-tree-lambda (depth)
(list 'lambda '(x)
(new-tree depth)))
(defun make-tree-function (lambda-tree)
(eval lambda-tree))
(defun eval-fitness (lambda-form-list input-output-list)
"Determines how well the lambda forms approach the wanted function
by comparing their output with the wanted output in the supplied test
cases. Returns a list of mean quadratic error sums."
(mapcar (lambda (lambda-form)
(let* ((actual-results (mapcar (make-tree-function lambda-form)
(mapcar #'first input-output-list)))
(differences (mapcar #'-
actual-results
(mapcar #'second input-output-list)))
(squared-differences (mapcar #'square
differences)))
(/ (reduce #'+ squared-differences)
(length squared-differences))))
lambda-form-list))
(defun tree-fitness (tree-list input-output-list)
"Creates a list of lists, each inner list is (tree fitness). Input
is a list of trees, and a list of test cases."
(mapcar (lambda (tree fitness)
(list tree fitness))
tree-list
(eval-fitness (mapcar #'make-tree-lambda tree-list)
input-output-list)))